CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/allswag.zip/SCREEN.SWG

Text File | 1993-12-08 | 96KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00048         SCREEN HANDLING ROUTINES                                          1      05-28-9313:56ALL                      SWAG SUPPORT TEAM        CLRSCR1.PAS              IMPORT              7           Procedure fillWord(Var dest; count, data: Word);πbeginπ  Inline(π    $C4/$BE/dest/          { les di, dest[bp] }π    $8B/$8E/count/         { mov cx, count[bp] }π    $8B/$86/data/          { mov ax,data[bp] }π    $FC/                   { cld }π    $F3/$AB                { rep stosw }π  )πend;ππProcedure ClrScr;πVarπ  screen: Array[1..25, 1..80, 1..2] of Char Absolute $b800:$0000;πbeginπ  fillWord(screen, sizeof(screen) div 2, $0720)πend;ππ{ or }ππProcedure ClrScr;πTypeπ  TScreen: Array[1..25, 1..80, 1..2] of Char;πVarπ  VideoSegment: Word;πbeginπ  if (MemW[$40:$10] and $30)=$30 thenπ    VideoSegment:=$B000π  elseπ    VideoSegment:=$B800;π  fillWord(ptr(VideoSegment, 0)^, sizeof(TScreen) div 2, $0720)πend;                                                      2      05-28-9313:56ALL                      SWAG SUPPORT TEAM        CLRSCR2.PAS              IMPORT              4           {π>How do you Write a clear screen Procedure in standard pascal forπ>the vax system?  I talking about a nice clear screen prgm that does'tπ>scroll everything off the screen.  Something that works in a flash..π}ππConstπ  clear_screen = CHR(27) + CHR(91) + CHR(50) +CHR(74);ππbeginπ  Write(clear_screen);π  readln;πend.                                                                   3      05-28-9313:56ALL                      SWAG SUPPORT TEAM        CLRSCR3.PAS              IMPORT              7           {πMICHAEL NICOLAIππYou want to clear the entire screen? Then just Write 00 in every Byte!πYou have to save the screen first, of course. :-)ππThis Procedure saves the screen, clears it, waits For a keystroke andπthen restores the screen:π}ππUsesπ  Crt;ππProcedure ClearScreen;πConstπ  lines = 50;   { number of lines }π  length = 160 * lines - 1;πVarπ  i      : Word;π  screen : Array [0..length] of Byte;πbeginπ { save the screen }π For i := 0 to length doπ  screen[i] := mem[$B800 : i];π { blank screen }π For i := 0 to length doπ  mem[$B800 : i] := 0;π { wait For keystroke }π While (NOT KeyPressed) do;π { restore screen }π For i := 0 to length doπ  mem[$B800 : i] := screen[i];πend;ππbeginπ  ClearScreen;πend.π                                                      4      05-28-9313:56ALL                      SWAG SUPPORT TEAM        DUALOUT1.PAS             IMPORT              21          {π> Who knows how to detect and access dual display's?ππAs this feature is only available if you're using VGA as the primary adapterπyou can get information about a second adapter by interrupt 10h.ππ        Get primary/secondary video adapter:π        interrupt:      10hπ        input:          AH = 1Ahπ                        AL = 00h                               (subFunction)π        output:         AL = 1Ah                (indicates Function support)π                        BL = code For active card              (primary one)π                        BH = code For inactive cardππ                        where following codes are valid:π                        00h     no cardπ                        01h     MDA With monochrome displayπ                        02h     CGA With CGA displayπ                        03h     reservedπ                        04h     EGA With EGA or multiscan displayπ                        05h     EGA With monochrome displayπ                        06h     reservedπ                        07h     VGA With monochrome displayπ                        08h     VGA With VGA or multiscan displayπ                        09h     reservedπ                        0Ah     MCGA With CGA display (PS/2)π                        0Bh     MCGA With monochrome display (PS/2)π                        0Ch     MCGA With color display (PS/2)π                        FFh     unknownππ        Set primary/secondary video adapter:π        interrupt:      10hπ        input:          AH = 1Ahπ                        AL = 01h                                (subFunction)π                        BL = code For active card        (here secondary one)π                        BH = code For inactive cardπ        output:         AH = 1Ah                 (indicates Function support)ππFirst you call subFunction 00h to get the code of your primary and secondaryπvideo adapter. Then you can toggle between them by using subFunction 01h.ππTo get back ontopic (Pascal code is needed ;-)) here's a simple example For aπtoggle Procedure:π}πUses Dos;ππProcedure ToggleAdapters;πVar Regs            : Registers;π    Active,Inactive : Byte;πbeginπ  Regs.AH := $1A;π  Regs.AL := $00;π  Intr($10,Regs);π  If Regs.AL=$1A Then           { is Function supported? (is VGA?) }π beginπ   Active   := Regs.BL;                      { exchange both codes }π   Inactive := Regs.BH;π   Regs.AH  := $1A;π   Regs.AL  := $01;π   Regs.BL  := Inactive;π   Regs.BH  := Active;π   Intr($10,Regs);                           { now you can't see me }π end;πend;π              5      05-28-9313:56ALL                      SWAG SUPPORT TEAM        GETCHAR1.PAS             IMPORT              12          {π│What would be the best way to find out what Character is at a certainπ│location on the screen.  For example, Lets say I went to locationπ│(10,2) and at that location is the letter 'S' now withoutπ│disturbing the letter S how can I determine if it is there or not?πππA 25-line by 80-column screen has 2,000 possible cursor positions. Theπ2,000 Words that begin at the memory location $B800:0000 (or $B000:0000 ifπyour machine is monochrome) define the current image. The first Byte ofπeach Word is the ASCII Character to be displayed, and the second Byte isπthe attribute of the display, which controls such Characteristics as colorπand whether it should blink....ππI you used the standard (X,Y) coordinate system to define a cursor positonπon the screen, With the upper left corner at (1,1) and lower right cornerπat (80,25), then With a lettle algebra you can see that the offset valueπFor a cursor position can be found at:ππ   Words:  80*(Y-1) + (X-1)πorπ   Bytes:  160*(Y-1) + 2*(X-1)πππHere's a Function that will return the Character at location (X,Y):ππ}πFunction GetChar(X,Y:Byte):Char;π  (* Returns the Character at location (X,Y) *)πConstπ  ColorSeg = $B800;     (* For color system *)π  MonoSeg  = $B000;     (* For mono system  *)πbeginπ  GetChar := Chr(Mem[ColorSeg:160*(Y-1) + 2*(X-1)])πend;π                                                                                                   6      05-28-9313:56ALL                      SWAG SUPPORT TEAM        GETCHAR2.PAS             IMPORT              9           {π>I need a routine that will go to a specific screen position and grab oneπ>or two Characters that are there (or next to it) - e.g It would go to rowπ>1 column 1 and return With the Character in that spot..ππTry this For TP 6.0π}ππUsesπ  Crt;ππFunction ScrnChar(x,y:Byte):Char;πVarπ  xkeep, ykeep : Byte;πbeginπ  xkeep := whereX;π  ykeep := whereY;π  GotoXY(x, y);π  Asmπ    push  bxπ    mov   ah,8π    xor   bx,bxπ    int   16π    mov   @Result,alπ    pop   bxπ  end;π  GotoXY(xkeep,ykeep)πend;π{πI am not sure about the "@Result" as being the correct name, but TP 6.0 has aπname that is used For the result of a Function. This should be Compatible withπthe Windows etc. of TP 6.0π}ππVarπ  ch : Char;π  Count : Integer;ππbeginπ  ClrScr;π  For Count := 1 to 500 doπ  beginπ    Write(chr(Count));π    if count mod 80 = 0 thenπ      Write(#13#10);π  end;π  ch := scrnChar(5,5);π  Write(#13#10#10#10#10#10,'The Character at position (5,5) is: ',ch);π  readln;πend.                                                              7      05-28-9313:56ALL                      SWAG SUPPORT TEAM        GETSTRNG.PAS             IMPORT              10          Unit scn_io;ππInterfaceππProcedure GetScreenStr(x, y, l: Integer; Var s: String);ππImplementationππProcedure GetChar(x, y: Integer; Var ch: Char);π(*** gets the Character from screen position x, y;π     x is horizontal co-ord, y is vertical;π     top left corner is 0,0 ***)πConstπ  base = $b800;            (* $b000 For mono *)πVarπ  screen_Byte: Byte;π  offs: Integer;πbeginπ  offs := ( (y*80) + x ) * 2;π  screen_Byte := mem[base: offs];π  ch := chr(screen_Byte);πend{proc..};ππProcedure PutChar(x, y: Integer; ch: Char);π(*** pits the Character ch to screen position x, y; ***)πConstπ  base = $b800;            (* $b000 For mono *)πVarπ  screen_Byte: Byte;π  offs: Integer;πbeginπ  offs := ( (y*80) + x ) * 2;π  screen_Byte := ord(ch);π  mem[base: offs] := screen_Byte;πend{proc..};ππProcedure GetScreenStr(x, y, l: Integer; Var s: String);π(*** gets the String from screen position x,y of length l ***)πVarπ  i: Integer;π  ch: Char;πbeginπ  s := '';π  For i := 1 to l doπ  beginπ    GetChar(x, y, ch);π    s := s + ch;π    inc(x);π    if x > 79 thenπ    beginπ      inc(y); x:= 0;π    end{if x >..};π  end{For i..}πend{proc..};ππend{Unit..}.π     8      05-28-9313:56ALL                      SWAG SUPPORT TEAM        SAVERES.PAS              IMPORT              10          Uses Dos,Crt;π{ saves and restores and area of screen }πConstπ   Max = 3;ππTypeπ   ScreenImage = Array[0..1999] of word;π   FrameRec    = Recordπ                    Upperleft    : Word;π                    LowerRight   : Word;π                    ScreenMemory : ScreenImage;π                 End;ππVARπ   SnapShot     : ^ScreenImage;π   FrameStore   : Array [1..10] of ^FrameRec;π   WindowNum    : Byte;ππProcedure OpenWindow(UpLeftX,UpLeftY,LoRightX,LoRightY : Byte);πBeginπ   SnapShot := Ptr( $B800, $0000);π   Inc(WindowNum);π   New(FrameStore[WindowNum]);π   WITH Framestore[WindowNum]^ doπ   Beginπ      ScreenMemory := SnapShot^;π      UpperLeft    := WindMin;π      LowerRight   := WindMax;π   end;π   Window(UpLeftX,UpLeftY,LoRightX,LoRightY);πend;ππProcedure CloseWindow;πBeginπ   With Framestore[WindowNum]^ doπ   Beginπ      Snapshot^ := ScreenMemory;π      Window ( (Lo(UpperLeft)+1), (Hi(UpperLeft)+1),π             (Lo(LowerRight)+1), (Hi(LowerRight)+1) );π   end;π   Dispose( Framestore[WindowNum]);π   Dec(WindowNum);πEnd;ππBeginπOpenWIndow(3,3,45,15);πClrScr;πReadkey;πCloseWindow;πEnd.π                                                9      05-28-9313:56ALL                      SWAG SUPPORT TEAM        SCRLTEXT.PAS             IMPORT              5           Usesπ  Crt;ππProcedure ScrollTextLine (x1, x2 : Integer ; y : Integer ; St : String) ;πbeginπ  While Length(St)<(x2-x1+1) Doπ    St:=St+' ' ;π  While not KeyPressed Doπ    beginπ      GotoXY(x1, y) ;π      Write(Copy(St, 1, x2-x1+1)) ;π      Delay(100) ;π      St:=Copy(St, 2, Length(St)-1)+St[1] ;π    end ;πend ;ππbeginπ  ClrScr;π  TextColor(lightgreen);π  scrollTextline(10,60,12,'Hello There!');πend.                                                                                                            10     05-28-9313:56ALL                      SWAG SUPPORT TEAM        SCRNSAVE.PAS             IMPORT              18          { GLEN WILSON }ππ{$m 2000,0,0}  (* Stops Pascal using all of memory *)π{$R-,s-,v-,b-,n-,l+}  (* Nothing important, helps keep the size down*)πProgram screensaver;  (* Only blanks screen on CGA/Mono not VGA/etc*)ππUsesπ  Dos, Crt;ππConstπ  TimerInt = $08;              {Timer Interrupt}π  KbdInt   = $09;              {Keyboard Interrupt}π  Timerlimit : Word = 5460;   {5 minute Delay}ππVarπ  Regs    : Registers;π  Cnt     : Word;π  PortNum : Word;π  PortOff : Word;π  Porton  : Word;π  OldKBDVEC   : Pointer;π  OldTimerVec : Pointer;π  i    : Real;π  code : Real;πππProcedure STI;πInline($FB);ππProcedure CLI;πInline($FA);ππProcedure CallOldInt(Sub : Pointer);π(* Primitive way of calling Old Interrupt, never the less, you can see what isπ   happening! *)πbeginπInline($9c/           { PushF }π       $FF/$5e/$06);  { Call DWord PTR [BP+6] }πend;ππProcedure Keyboard(flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word); Interrupt;ππbeginπ  CallOldInt(OldKbdVec);π  if (CNT >= Timerlimit) thenπ    port[portnum] := porton;π  Cnt := 0;π  STI;πend;ππProcedure Clock(flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word); Interrupt;πbeginπ  CallOldInt(OldTimerVec);π  if (CNT > Timerlimit) thenπ    Port[portnum] := portoffπ  elseπ    Inc(Cnt);π  STI;πend;πππbeginπ Regs.AH := $0F;π INTR($10, regs); (* determine Type of video adapter (Mono or Cga) *)ππ  if Regs.AL= 7 thenπ  beginπ    Portnum := $3b8;π    Portoff := $21;π    PortOn  := $2d;π  endπ  elseπ  beginπ    Portnum:=$3d8;π    Portoff:=$25;π    porton :=$2d;π  end;ππ  (* Save original Procedures *)π  GetIntVec(KbdInt, OldKbdVEc);π  GetIntVec(TimerInt, OldTimerVec);ππ  (* Install new Interrupts *)π  SetIntVec(timerint, @clock);π  SetIntVec(KbdInt, @Keyboard);ππ  Cnt := 0; (* Initialize counter *)π  Keep(0); (* Tell Pascal to keep us in memory *)πend.ππ{πit seems rather complex but most of that crap is For turningπon and off the screen.  if you don't have a CGA or MONO you can replace theπPort crap With Writeln statements so you can see whats hapening.ππBTW This is an example from a Programming book ( can't remember what it isπcalled ) becareful, It might be covered by Copy right laws.π}π                               11     05-28-9313:56ALL                      SWAG SUPPORT TEAM        SCRWRIT1.PAS             IMPORT              19          {πDoes any one know of a way to Write 80 chrs to the bottom line of theπscreen without the screen advancing?ππYou're gonna have to Write directly to the screen : the problem is that,πwhen you use std ways to Write to the screen, the cursor is always oneπCharacter ahead of the Text you displayed... so standard display procsπcan not be used to Write to the 80th Character of the 25th line.ππHere is a simple proc to Write Text directly to the screen :π}ππConstπ     VideoSeg  : Word = $b800 ;    { Replace With $b000 if no color card }ππProcedure DisplayString(x, y : Byte; Zlika : String; Attr : Byte); Assembler ;ππ{ x and y are 0-based }πAsmπ  Mov  ES, VideoSeg        { Initialize screen segment adr }ππ  { Let's Compute the screen address of coordinates (x, y) }π  { Address:=(160*y)+(x ShL 2) ; }π  Mov  AL, 160             { 160 Bytes per screen line }π  Mul  Byte Ptr yπ  Mov  BL, xπ  Xor  BH, BHπ  ShL  BX, 1               { 2 Bytes per on-screen Character }π  Add  BX, AX              { BX contains offset where to display }ππ  { Initialize stuff... }π  Push DS                  { Save DS }π  ClD                      { String ops increment DI, SI }π  LDS  SI, Zlika           { DS:DI points to String }π  LodSB                    { Load String length in AL }π  Mov  CL, AL              { Copy it to CL }π  Xor  CH, CH              { CX contains String length }π  Mov  DI, BX              { DI contains address where to display }π  Mov  AH, Attr            { Attribute Byte in AH }π@Boucle:π  LodSB                    { Load next Char to display in AL }π  StoSW                    { Store Word (attr & Char) to the screen }π  Loop @Boucle             { Loop For all Chars }ππ  Pop  DS                  { Restore DS }πend ;ππ{πFurthermore, this is definitely faster than using Crt.Write...πI will ask those ones owning a CGA card to Forgive me, I ommited toπinclude the usual snow-checking... but this intends to be a shortπexample :-))πAlso note that there is no kind of checking, so you can Write out ofπthe screen if you want... but that's no good idea.πBTW, the attribute Byte value is Computed With the "magic Formula"πAttr:=Foreground_Color + (16 * Background_color) [ + 128 For blinking ]π}π                                                                                                 12     05-28-9313:56ALL                      SWAG SUPPORT TEAM        SCRWRIT2.PAS             IMPORT              21          {π SO> Got a question For you all out there..... How the heck can I Write aπ SO> Character  into the bottom right corner of a Window without the Windowπ SO> scrolling?π SO>π SO> if anyone knows some way to keep the Write command from Forwarding theπ SO> cursor  position Pointer, that would be fine enough For me.....ππSean, here is a way to do it without resorting to poking the screen.π}ππ{$A+,B+,D+,E-,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V-,X+,Y+}π{$M 8192,0,0}ππUsesπ  Crt;πVarπ  index1, Index2: Byte;ππbeginπ  ClrScr;ππ{******************************************π First Write top line of bordered displayπ******************************************}ππ  Write ('╔');                     {Write top Left Corner}π  For Index1 := 1 to 78 do         {Write top Horizontal line }π    Write ('═');π  Write ('╗');                     {Write top Right Corner}ππ{*******************************************π Now Write Bottom line of bordered displayπ*******************************************}ππ  Write ('╚');                     {Write Bottom Left Corner}π  For Index1 := 1 to 78 do         {Write Bottom horizontal line}π    Write ('═');π  Write ('╝');                     {Write Bottom Right Corner}ππ{********************************************************************π Now inSERT 23 lines of Left&Right bordered display, pushing bottomπ line down as we doπ********************************************************************}ππ  For Index1 := 1 to 23 do begin   { Repeat 23 times }π    GotoXY (1, 2);                 {Move cursor back to Col 1, Line 2}π    InsLine;                       {Insert blank line (Scroll Text down)}π    Write ('║');                   {Write Left border vertical caracter}π    For Index2 := 1 to 78 do       {Write 78 spaces}π      Write (' ');π    Write ('║');                   {Write Right border vertical caracter}π  end;ππ{***********************************************************π I added this so the Program would pause For a key. This wayπ it will allow you to see that it does not scroll up sinceπ the cursor never Writes to position 25,80π***********************************************************}ππ  Asm                              {Assembler code to flush keyboard}π    mov Ax, 0C00h;π    Int 21h;π  end;π  ReadKey ;                        {Wait For a keypress}ππend.ππ{πBTW, this was written, Compiled and Tested in BP 7.0 but should work inπTP 4.0 and up if you remove the Assembler stuff.π}                                                                                                                             13     05-28-9313:56ALL                      SWAG SUPPORT TEAM        SPEEDVID.PAS             IMPORT              35          Unit SpeedVid;ππ{ High speed Text-video routines For working With binary Files, direct  }π{ screen access etc.  (c)1993 Chris Lautenbach                          }π{                                                                       }π{ You are hereby permitted to use this routines, so long as you give me }π{ credit.  If you modify them, do not distribute the modified version.  }π{                                                                       }π{ Notes:   This Unit will work fine in 50 line mode, or on monochrome   }π{          monitors.  Remember; when working in 50 line mode, always    }π{          make sure you call Window(1,1,80,50) so that WindMax is      }π{          updated With the correct screen co-ordinates.  In addition,  }π{          the ScrollScreen() routine is much faster than it's standard }π{          BIOS Int 10h counterpart.                                    }π{                                                                       }π{          Turbo Professional users have no need For FastWrite(),       }π{          VideoMode, or ScreenHeight - since these are approximations  }π{          are provided For use by people who do not have the TpCrt     }π{          Unit.                                                        }π{                                                                       }π{ If you need to contact me, I can be found in the NANet, City2City,    }π{ and Intelec Pascal echoes - or at my support BBS, Toronto Twilight    }π{ Communications [phone]. Internet: [e-mail] }ππInterfaceππUsesπ  Dos, Crt;ππConstπ  MonoMode : Boolean = False;ππTypeπ  ScreenLine = Array[1..160] of Char;π  ScreenBuffer = Array[1..50] of ScreenLine;π  DirectionType = (Up, Down);ππVarπ  VideoScreen : ScreenBuffer Absolute $B800:$0000;π  MonoScreen  : ScreenBuffer Absolute $B000:$0000;ππFunction  VideoMode : Byte;                               { Get video mode }πFunction  ScreenHeight : Byte;          { Return height of screen in lines }πProcedure ScrollScreen(Direction : DirectionType); { Scroll screen up/down }πProcedure FastWrite(st:String; x,y,color:Byte);    { Write Text to vid mem }πProcedure RestoreScreen(Var p:Pointer);             { Restore saved screen }πProcedure SaveScreen(Var p:Pointer);            { Save screen to a Pointer }ππImplementationππFunction VideoMode : Byte;πVarπ  Mode : Byte;πbeginπ  Asmπ    MOV AH, 0Fh              { Set Function to 0Fh - Get current video mode }π    INT 10h                  { Call interrupt 10h - Video Services }π    MOV Mode, AL             { Move INT 10h result to Mode Variable }π  end;π  VideoMode := Mode;πend;ππFunction ScreenHeight:Byte;πbeginπ  ScreenHeight := (Hi(WindMax) + 1);πend;ππProcedure ScrollScreen(Direction : DirectionType);πbeginπ  Case Direction ofπ    Up   :π      If MonoMode thenπ        Move(MonoScreen[2],MonoScreen[1],Sizeof(ScreenLine)*(ScreenHeight-1))π      ELSEπ        Move(VideoScreen[2],VideoScreen[1],Sizeof(ScreenLine)*(ScreenHeight-1));π    Down :π      If MonoMode thenπ        Move(VideoScreen[1],VideoScreen[2],Sizeof(ScreenLine)*(ScreenHeight-1))π      ELSEπ        Move(VideoScreen[1],VideoScreen[2],Sizeof(ScreenLine)*(ScreenHeight-1));π  end; { Case }πend;ππProcedure FastWrite(st:String; x,y,color:Byte);π{ Write a String directly to the screen, x=column, y=row }πVarπ  idx, cdx : Byte;πbeginπ  idx := x * 2;π  cdx := 1;π  Repeatπ    {$R-}π    If MonoMode thenπ    beginπ      MonoScreen[y][idx+2] := Chr(Color);π      MonoScreen[y][idx+1] := St[cdx];π    endπ    ELSEπ    beginπ      VideoScreen[y][idx+2] := Chr(Color);π      VideoScreen[y][idx+1] := St[cdx];π    end;π    {$R+}π    Inc(idx,2);π    Inc(cdx,1);π  Until cdx>=length(st);πend;ππProcedure RestoreScreen(Var p:Pointer);πbeginπ If Assigned(P) then  { make sure this Pointer IS allocated }π beginπ   If MonoMode thenπ     Move(P^, MonoScreen, 4000)π   ELSEπ     Move(P^, VideoScreen, ScreenHeight*SizeOf(ScreenLine));π   FreeMem(P,ScreenHeight*Sizeof(ScreenLine));π end;πend;ππProcedure SaveScreen(Var p:Pointer);πbeginπ  If not Assigned(P) then   { make sure Pointer isn't already allocated }π  beginπ    GetMem(P,ScreenHeight*Sizeof(ScreenLine));π    If MonoMode thenπ      Move(MonoScreen, P^, 4000)π    ELSEπ      Move(VideoScreen, P^, ScreenHeight*Sizeof(ScreenLine));π  end;πend;πππbeginπend.            14     05-28-9313:56ALL                      SWAG SUPPORT TEAM        TESTVID.PAS              IMPORT              29          Program TestVid;ππ{ High speed Text-video routines For working With binary Files, direct   }π{ screen access etc.  (c)1993 Chris Lautenbach                           }π{                                                                        }π{ You are hereby permitted to use this routines, so long as you give me  }π{ credit.  If you modify them, do not distribute the modified version.   }π{                                                                        }π{ This is the example Program, see SPEEDVID.PAS For the actual Unit      }π{ code, and usage information.                                           }π{                                                                        }π{ "ScreenFile" is a File containing sequential binary screen images. The }π{ easiest way to make these, is to draw several screens in a Program     }π{ like TheDraw, then save them as Binary.  After you are done, copy them }π{ all to one File, like so:                                              }π{                                                                        }π{ COPY /B SCREEN1.BIN+SCREEN2.BIN+SCREEN3.BIN SCREEN.BIN                 }π{                                                                        }π{ Note: the /B option is NECESSARY.  Without specifying binary mode,     }π{       COPY will insert ^Z's and other wierd stuff that will screw up   }π{       the resulting File.                                              }ππUses  Dos, Crt, SpeedVid;ππVar   ScreenFile : File of ScreenLine;π      StartLine, TempLine, idx : Integer;π      Cmd : Char;π      p : Pointer;ππProcedure ShowScreenLine(Index:Word);πbeginπ  If StartLine+Index<Filesize(ScreenFile) thenπ  beginπ    Seek(ScreenFile, StartLine+Index-1);π    Read(ScreenFile, VideoScreen[Index]);π  end;πend;ππbeginπ  MonoMode := (VideoMode = 7);π  SaveScreen(P);π  Assign(ScreenFile,'testvid.exe');π  {$I-} Reset(ScreenFile); {$I+}π  If IOResult<>0 thenπ  beginπ    Writeln('Error: Cannot open SCREEN.BIN.');π    Halt;π  end;π  StartLine:=0;π  For TempLine:=1 to ScreenHeight do ShowScreenLine(TempLine);π  Repeatπ    Repeat Until KeyPressed;π    Cmd:=ReadKey;π    If Cmd=#0 thenπ    beginπ      Cmd:=ReadKey;π      Case Cmd ofπ{Down}  #80 : If StartLine+1<Filesize(ScreenFile) thenπ              beginπ                Inc(StartLine);π                ScrollScreen(Up);π                ShowScreenLine(ScreenHeight);π              end;π{Up}    #72 : If StartLine-1>=0 thenπ              beginπ                Dec(StartLine);π                ScrollScreen(Down);π                ShowScreenLine(1);π              end;π{PgDn}  #81 : beginπ                If StartLine+ScreenHeight<Filesize(ScreenFile) thenπ                  TempLine:=ScreenHeightπ                    ELSEπ                  TempLine:=ScreenHeight-(Filesize(ScreenFile)-ScreenHeight);π                For idx:=1 to TempLine doπ                beginπ                  Inc(StartLine);π                  ScrollScreen(Up);π                  ShowScreenLine(ScreenHeight);π                end;π              end;π{PgUp}  #73 : beginπ                If StartLine-ScreenHeight>=0 thenπ                  TempLine:=ScreenHeightπ                    ELSEπ                  TempLine:=StartLine;π                For idx:=1 to TempLine doπ                beginπ                  Dec(StartLine);π                  ScrollScreen(Down);π                  ShowScreenLine(1);π                end;π              end;π      end; {case}π    end;π  Until Cmd=#27; {ESC}π  Close(ScreenFile);π  RestoreScreen(P);πend.π                                                         15     05-28-9313:56ALL                      SWAG SUPPORT TEAM        TEXTMODE.PAS             IMPORT              7           {π A small follow-up to the VGA tricks:π how about a 40x12 Textmode (posted earlier in the Assembler conference):π}ππProcedure Set12x40; Assembler;πAsmπ  MOV     AX, 1π  inT     $10            { activate 40x25 Text With BIOS }π  MOV     DX, $03D4      { CrtC }π  MOV     AL, 9          { maximum scan line register }π  OUT     DX, ALπ  inC     DXπ  in      AL, DXπ  or      AL, $80        { Double each scan-line   bit7 = 1 }π  OUT     DX, ALπ  MOV     AX, $0040      { set up BIOS data area access }π  MOV     ES, AXπ  MOV     AL, $0B        { BIOS txtlines on 12 = $B +1 }π  MOV     ES:[$0084], AL { so Programs like QEDIT will work With this }πend;ππ                                                                                                                   16     05-28-9313:56ALL                      SWAG SUPPORT TEAM        TEXTWDTH.PAS             IMPORT              13          { Keld Hansen }πProcedure SetCrtC; NEAR; Assembler;πConstπ  HorizParms : Array[1..2,1..7] of Word =π               (($6A00,$5901,$5A02,$8D03,$6004,$8505,$2D13),π                ($5F00,$4F01,$5002,$8203,$5504,$8105,$2813));πAsmπ  PUSH    DXπ  MOV     DX,ES:[0063h]π  PUSH    BXπ  MOV     AX,1110hπ  xor     CX,CXπ  INT     10hπ  POP     BXπ  MOV     AL,11hπ  OUT     DX,ALπ  INC     DXπ  in      AL,DXπ  DEC     DXπ  MOV     AH,ALπ  MOV     AL,11hπ  PUSH    AXπ  and     AH,7Fhπ  OUT     DX,AXπ  xor     BH,BHπ  SUB     BL,8π  NEG     BXπ  and     BX,14π  LEA     SI,[BX+OFFSET HorizParms]π  MOV     CX,7π@LOOP:  LODSWπ  OUT     DX,AXπ  LOOP    @LOOPπ  POP     AXπ  OUT     DX,AXπ  POP     DXπend;ππProcedure SetCharWidth(W : Word); Assembler;πAsmπ  MOV     ES,Seg0040π  MOV     BL,Byte PTR Wπ  MOV     BH,ES:[0085h]π  CALL    SetCrtCπ  MOV     DX,03C4hπ  MOV     AX,0100hπ  CLIπ  OUT     DX,AXπ  MOV     BX,0001hπ  CMP     W,8π  JE      @L01π  MOV     BX,0800hπ@L01:       MOV     AH,BLπ  MOV     AL,1π  OUT     DX,AXπ  MOV     AX,0300hπ  OUT     DX,AXπ  STIπ  MOV     BL,13hπ  MOV     AX,1000hπ  INT     10hπ  MOV     AX,1000hπ  MOV     BX,0F12hπ  INT     10hπ  xor     DX,DXπ  MOV     AX,720π  div     Wπ  MOV     ES:[004Ah],AXπend;ππ{πSetCharWidth can then be called With 8 (giving 90 Characters per line) or 9π(giving 80 Characters per line) after having switched into f.ex. 80x28 (byπselecting the appropriate number of scan lines and font size).π}π                                                                                  17     05-28-9313:56ALL                      SWAG SUPPORT TEAM        VIDEORAM.PAS             IMPORT              9           {πAuthor : BERNIE PALLEKππ> Thanks to those of you who have been answering my question aboutπ> writing to the last position on the far right bottom of the screen.π> As you will recall, the trouble I had was that when you Write to thatπ> position (position 80, line 25) using a Write (not a Writeln) statementππAnother solution would be to create a Procedure that directly Writes to theπvideo ram, like this:π}ππConstπ  vidSeg = $B800;  { $B000 For monochrome monitors }ππProcedure WriteAt(x1, y1 : Byte; msg : String);πVarπ  i : Integer;πbeginπ  For i := 1 to Length(msg) doπ    Mem[vidSeg : (x1 + i - 1) * 2 + (y1 - 1) * 160] := msg[i];πend;ππ{πThis will change the Text on any place on the screen, disregarding the cursorπposition.  Be careful, though!  if you Write a message With, say, 20πCharacters, and start it at 80, 25, only the first letter will be visible, andπthe rest of the String will over-Write other areas of ram, which could causeπmayhem!  Use With caution!π}                                               18     06-08-9308:23ALL                      SWAG SUPPORT TEAM        Three FAST write RoutinesIMPORT              21          π{ THREE DIFFERENT WAYS TO WRITE TO SCREEN WITH ROW AND COLUMN }π{ TWO ARE VERY FAST AND ALLOW COLOR }ππprocedure QWrite( Column, Line , Color : byte; S : STRING );ππvarπ   VMode  : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }π   NumCol : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }π   VSeg   : WORD;π   OfsPos : integer;  { offset position of the character in video RAM }π   vPos   : integer;π   sLen   : Byte ABSOLUTE S;ππBeginπ  If VMode in [0,2,7] THEN VSeg := $B000 ELSE VSeg := $B800;π  OfsPos   := (((pred(Line) * NumCol) + pred(Column)) * 2);π  FOR vPos := 0 to pred(sLen) doπ      MemW[VSeg : (OfsPos + (vPos * 2))] :=π                     (Color shl 8) + byte(S[succ(vPos)])πEnd;πππprocedure fastwrite(x, y, f, b: byte; s : STRING);ππ{ Does a direct video write -- extremely fast.π  X, Y = screen location of first byte;π  S = string to display;π  F = foreground color;π  B = background color. }ππtype  videolocation = record    { the layout of a two-byte video location }π        videodata: char;        { character displayed }π        videoattribute: byte;   { attributes }π        end;ππvar cnter: byte;π    videosegment: word;         { the location of video memory }π    monosystem: boolean;        { mono vs. color }π    vidptr: ^videolocation;     { pointer to video locations }ππbeginππ{ Find the memory location where the string will be displayed at, according toπ  the monitor type and screen location.  Then associate the pointer VIDPTR withπ  that memory location: VIDPTR is a pointer to type VIDEOLOCATION.  Insert aπ  character and attribute; now go to the next character and video location. }ππ  monosystem := (lastmode in [0,2,7]);π  if monosystem then videosegment := $b000 else videosegment := $b800;π  vidptr := ptr(videosegment, 2*(80*(y - 1) + (x - 1)));π  for cnter := 1 to length(s) do beginπ    vidptr^.videoattribute := (b shl 4) + f;  { high nibble=bg; lo nibble=fg }π    vidptr^.videodata := s[cnter];            { put character at location }π    inc(vidptr);                              { go to next video location }π    end;π  end;πππProcedure Print(x,y : Byte; S : String);πBEGINπ  ASMπ  MOV DH, Y    { DH = Row (Y) }π  MOV DL, X    { DL = Column (X) }π  DEC DH       { Adjust For Zero-based Bios routines }π  DEC DL       { Turbo Crt.GotoXY is 1-based }π  MOV BH,0     { Display page 0 }π  MOV AH,2     { Call For SET CURSOR POSITION }π  INT 10hπ  END;πWRITE(S);πEND;π                                                                                                               19     06-22-9309:22ALL                      SWAG SUPPORT TEAM        A CRT Replacement        IMPORT              47          unit scrn;π{$D-,I-,S-,V-}πinterfaceπUsesπ    Dos;πConstπ      display : Boolean = true;π      FGround : Byte = 0;π      BGround : Byte = 0;π      attribute : Byte = 0;π      apage : Word = $B800;π      apoint : Word = 0;π      { foreground and background colors }π      Black        = 0;π      Blue         = 1;π      Green        = 2;π      Cyan         = 3;π      Red          = 4;π      Magenta      = 5;π      Brown        = 6;π      LightGray    = 7;ππ      { foreground colors }π      DarkGray     = 8;π      LightBlue    = 9;π      LightGreen   = 10;π      LightCyan    = 11;π      LightRed     = 12;π      LightMagenta = 13;π      Yellow       = 14;π      White        = 15;ππ      { add for blinking characters }π      Blink        = 128;ππVARπ    regs : Registers;ππFunction GetMode : Byte;π{returns the current video mode}ππProcedure SetMode (m : Byte);π{sets the video mode}ππProcedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);π{scrolls the window up (nbr is +) or down (nbr is -)}π{If nbr is 0 or out of range then the screen clears}π{ur is the upper row, lc is the left column,π lr is the lower row, and rc is the right column}π{Note:  using an out-of-range number may have unpredictableπ results on the colors...it is not recommended}ππProcedure SetCursor (s, e : Byte);π{sets the size of the cursor}π{s is the starting line, e is the ending line}ππProcedure SetAPage (page : Word);π{Set the Active (drawing) page}ππProcedure SetVPage (vpage : Byte);π{Set the display page}ππFunction DisplayCursor (display1 : Boolean) : Boolean;π{hides or displays the cursor}ππFunction Xis : Byte;π{Tells you what the X coordinate is for the current active page}ππFunction Yis : Byte;π{Tells you what the Y coordinate is for the current active page}ππProcedure PXY (x, y : Byte);π{sets the coordinates on the current active page}π{To move the cursor on the visual page, first make the visual pageπ and active page the same}π{x is the row, y is the column}ππProcedure SetFGround (FG : Byte);π{sets the foreground color}π{constants can be used}π{add 128 or the constant BLINK to make the foreground blink}ππProcedure SetBGround (BG : Byte);π{sets the background color}π{constants can be used}ππProcedure PWrite (S : String);π{writes a string to the current active page}π{numbers must be converted to a string before calling this procedure}ππProcedure PWriteln (S : String);ππProcedure ClrScrn;π{Clear the current active page}ππimplementationππFunction GetMode : Byte;π{returns the current video mode}πBeginπ     regs.ah := $0F;π     Intr($10,regs);π     GetMode := regs.al;πEnd;ππProcedure SetMode (m : Byte);π{sets the video mode}πBeginπ     regs.ah := 0;π     regs.al := m;π     Intr($10,regs);πEnd;ππProcedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);π{scrolls the window up (nbr is +) or down (nbr is -)}π{If nbr is 0 or out of range then the screen clears}πBeginπ    Dec(ur);π    Dec(lc);π    Dec(lr);π    Dec(rc);π    If nbr < 0 Then regs.ah := 7 Else regs.ah := 6;π    regs.al := Abs(nbr);π    regs.bh := attribute;π    regs.ch := ur;π    regs.cl := lc;π    regs.dh := lr;π    regs.dl := rc;π    Intr($10,regs);πEnd;ππProcedure SetCursor (s, e : Byte);πBeginπ    regs.ah := 1;π    regs.ch := s;π    regs.cl := e;π    Intr($10,regs);πEnd;ππProcedure SetAPage (page : Word);πBeginπ    apage := $B800 + (page * $100);πEnd;ππProcedure SetVPage (vpage : Byte);πBeginπ    regs.ah := 5;π    regs.al := vpage;π    Intr($10,regs);πEnd;ππFunction DisplayCursor(display1 : Boolean) : Boolean;πBeginπ    If Not(display1) Then Beginπ       regs.dh := 50;π       regs.dl := 0;π       Endπ    Else regs.dx := apoint;π    regs.ah := 2;π    regs.bh := (apage - $B800) DIV $100;π    Intr($10,regs);π    display := display1;πEnd;ππFunction Xis : Byte;πVar    cpage : Word;πBeginπ    cpage := (apage - $B800) DIV $100;π    Xis := (Mem[$40:$51+(cpage * 2)]) + 1;πEnd;ππFunction Yis : Byte;πVar    cpage : Word;πBeginπ    cpage := (apage - $B800) DIV $100;π    Yis := (Mem[$40:$50+(cpage * 2)]) + 1;πEnd;πππProcedure PXY (x, y : Byte);πBeginπ    Dec(x);π    Dec(y);π    regs.dh := x;π    regs.dl := y;π    regs.ah := 2;π    regs.bh := (apage - $B800) DIV $100;π    Intr($10,regs);π    If Not(display) Then Beginπ       regs.dh := 50;π       regs.dl := 0;π    regs.ah := 2;π    regs.bh := (apage - $B800) DIV $100;π    Intr($10,regs);π    End;π    apoint := x * 80 * 2 + y * 2;πEnd;ππProcedure SetFGround (FG : Byte);πBeginπ    FGround := FG;π    attribute := BGround * 16 + FGround;πEnd;ππProcedure SetBGround (BG : Byte);πBeginπ    BGround := BG;π    attribute := BGround * 16 + FGround;πEnd;ππProcedure PWrite (S : String);πVarπ    Len, x, y : Byte;π    tmp : Word;πBeginπ    If Length(S) = 0 Then Exit;π    tmp := apoint;π    For Len := 0 To Length(S) - 1 Do Beginπ        Mem[apage:apoint+Len] := Ord(S[Len+1]);π        Inc(apoint);π        Mem[apage:apoint+Len] := attribute;π    End;π    apoint := (tmp + Length(S) * 2) DIV 2;π    y := apoint MOD 80;π    x := apoint DIV 80;π    Inc(x);π    Inc(y);π    PXY(x,y);π    If Not(display) Then Beginπ       regs.dh := 50;π       regs.dl := 0;π    regs.ah := 2;π    regs.bh := (apage - $B800) DIV $100;π    Intr($10,regs);π    End;πEnd;ππProcedure PWriteln (S : String);πVarπ    Len, x, y : Byte;π    tmp : Word;πBeginπ    If Length(S) = 0 Then Exit;π    tmp := apoint;π    For Len := 0 To Length(S) - 1 Do Beginπ        Mem[apage:apoint+Len] := Ord(S[Len+1]);π        Inc(apoint);π        Mem[apage:apoint+Len] := attribute;π    End;π    apoint := (tmp + Length(S) * 2) DIV 2;π    x := apoint DIV 80 + 2;π    y := 1;π    PXY(x,y);π    If Not(display) Then Beginπ       regs.dh := 50;π       regs.dl := 0;π    regs.ah := 2;π    regs.bh := (apage - $B800) DIV $100;π    Intr($10,regs);π    End;πEnd;ππProcedure ClrScrn;πVarπ    x : Word;πBeginπ    x := 0;π    While x < 4048 Do Beginπ      Mem[apage:x] := $20;π      Inc(x);π      Mem[apage:x] := attribute;π      Inc(x);π      End;πEnd;ππ{initializes the foreground and backbround colors}πBeginπ    regs.ah := 8;π    regs.bh := 0;π    Intr($10,regs);π    attribute := regs.ah;π    FGround := attribute MOD 16;π    BGround := (attribute - FGround) DIV 16;πEnd.ππ                                                                     20     06-22-9309:22ALL                      SWAG SUPPORT TEAM        Screen Copy Utility      IMPORT              22          unit scrncopy;πinterfaceππConstπ     bord : ARRAY [0..2, 0..5] Of Byte = (π     ( 32, 32, 32, 32, 32, 32),π     ( 196, 179, 218, 191, 217, 192),π     ( 205, 186, 201, 187, 188, 200));ππprocedure copyscrn (scrn1,scrn2 : Byte);π{copy the screen}ππProcedure savescrn (scrn : Byte);π{saves the designated screen in RAM memory}ππProcedure restorescrn (scrn : Byte);π{restores the screen to the designated page}ππprocedure drawborder (Fg,Bg,ur,lc,lr,rc,lines,page : Word);π{draw the borders, optionally clears the screen}π{Fg is the foreground color, Bg is the background color,π ur is the upper row, lc is the left column,π lr is the lower row, rc is the right column,π lines is:π   0 for clear screen;π   1 for single lines (─┐);π   2 for double lines (═╗);π page is the screen page to draw the border on}ππimplementationπTypeπ    Hold = ARRAY[0..4047] Of Byte;ππVARπ    x : Word;π    tmpscrn : ^Hold;πProcedure copyscrn (scrn1, scrn2 : Byte);πBeginπ    For x := 0 To 4047 Doπ        Mem[$B800:(scrn2*$1000+x)] := Mem[$B800:(scrn1*$1000+x)];πEnd;πProcedure savescrn (scrn : Byte);πBeginπ    New(tmpscrn);π    For x := 0 To 4047 Doπ        tmpscrn^[x] := Mem[$B800:(scrn*$1000+x)];πEnd;ππProcedure restorescrn (scrn : Byte);πBeginπ    For x := 0 To 4047 Doπ        Mem[$B800:(scrn*$1000+x)] := tmpscrn^[x];π        Dispose(tmpscrn);πEnd;ππProcedure drawborder (Fg,Bg,ur,lc,lr,rc,lines,page : Word);πVARπ    x, y, point : Word;πBeginπ    page := $B800 + (page * $100);π    Fg := 16 * Bg + Fg;π    Dec(ur);π    Dec(lc);π    Dec(lr);π    Dec(rc);π    point := ur * 80 * 2 + lc * 2;π    Mem[page:point] := bord[lines,2];π    Mem[page:point + 1] := Fg;π    point := point + 2;π    For x := point To (ur * 80 * 2 + (rc-1) * 2) + 1 Do Beginπ        Mem[page:x] := bord[lines,0];π        Inc(x);π        Mem[page:x] := Fg;π        End;π    point := ur * 80 * 2 + rc * 2;π    Mem[page:point] := bord[lines,3];π    Mem[page:point+1] := Fg;π    For x := ur + 1 To lr - 1 Do Beginπ        point := x * 80 * 2 + lc * 2;π        Mem[page:point] := bord[lines,1];π        Mem[page:point + 1] := Fg;π        For y := lc + 1 To rc - 1 Do Beginπ        point := x * 80 * 2 + y * 2;π        Mem[page:point] := 32;π        Mem[page:point+1] := Fg;π        End;π        point := x * 80 * 2 + rc * 2;π        Mem[page:point] := bord[lines,1];π        Mem[page:point + 1] := Fg;π        End;π    point := lr * 80 * 2 + lc * 2;π    Mem[page:point] := bord[lines,5];π    Mem[page:point + 1] := Fg;π    point := point + 2;π    For x := point To (lr * 80 * 2 + (rc-1) * 2) + 1 Do Beginπ        Mem[page:x] := bord[lines,0];π        Inc(x);π        Mem[page:x] := Fg;π        End;π    point := lr * 80 * 2 + rc * 2;π    Mem[page:point] := bord[lines,4];π    Mem[page:point+1] := Fg;πEnd;ππEnd.ππ                                                                                                                   21     07-16-9306:05ALL                      SEAN PALMER              Fast Direct Screen WritesIMPORT              37     r   (*π===========================================================================π BBS: Canada Remote SystemsπDate: 06-22-93 (23:10)             Number: 27381πFrom: SEAN PALMER                  Refer#: NONEπ  To: LOU DUCHEZ                    Recvd: NOπSubj: FAST DIRECT WRITES             Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πLD>SP>I've optimized it a little, if you're interested... 8)ππLD>SP>procedure qwrite(x, y: byte; s: string; f, b: byte);ππLD>Interesting optimizations -- do I assume that Inc, Dec, Pred, and SuccπLD>are faster than I had ever imagined?  (Shoot, I always figured they'd beπLD>a lot slower than normal arithmetic!)  Thanks!ππSucc and Pred are faster for byte-sized ordinals (at least in TP 6.0)πthan +1 and -1. The same for word-size. See, with +1 and -1, the byteπgets converted into a word first, but with Succ() and Pred() itπstays a byte... Inc(I) is faster than I:=I+1 or I:=Succ(I) stuff in 6.0πbut I think 7.0+ optimize them all to the same code...not sure, I don'tπhave 7.0...8(ππActually the fastest part of what I did is to pre-calculate theπattribute as the hi byte of a word, and use word stores instead of byteπstores. Could be done alot faster in assembly (don't access anyπmemory-based variables that way, it's all in registers..8)ππHere is a direct screen write unit I wrote in BASM. VERY fast...π*)ππ{$A-,B-,S-,V-X+}πunit Direct;πinterfaceππCONSTπ vSeg:word=$B800;  {change for mono}ππVARπ  VMode   : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }π  ScrCols : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }ππ{in following parms, s=source,d=destination,n=count, words are offsetsπ into video memory (you calculate them with ((y*80+x)*2)}π{I did this mainly so less parms would have to be sent, as TP does aπ good job of the arithmetic for that expression...Oh well if you reallyπ don't like it I could make these use x and y coords, but this wasπ basically chopped from another project of mine..}ππprocedure moveScr(s,d,n:word);    {one part of screen to another}πprocedure toScr(var s;d,n:word);  {from string to video ram}πprocedure toScrA(var s;d,n:word;a:byte); {ditto with attribute also}πprocedure fillScr(d,n:word;c:char);      {mainly useful for rows}πprocedure fillAttr(d,n:word;a:byte);     {ditto}ππ{ I added the following to make this GREAT code more useful for us hackers !!}π{ Gayle Davis 06/26/93 }ππfunction  ScreenAdr (Row,Col : Byte) : WORD;πprocedure Qwrite(Row, Col, Attr: byte; S: string);ππimplementationπππprocedure moveScr(s,d,n:word);assembler;asmπ mov cx,n; jcxz @X;π push ds; mov ax,vSeg; mov es,ax; mov ds,ax;π mov si,s; shl si,1;π mov di,d; shl di,1;π cmp si,di; jb @REV;  {move in reverse to prevent overwrite}π cld; jmp @GO;π@REV: std; shl cx,1; add si,cx; add di,cx; shr cx,1; {start at end}π@GO: repz movsw; {move attr too!}π pop ds;π@X:π end;ππprocedure toScr(var s;d,n:word);assembler;asmπ mov cx,n; jcxz @X;π push ds; mov es,vSeg;π mov di,d; shl di,1;π lds si,s; cld;π@L: movsb; inc di; loop @L;π pop ds;π@X:π end;ππprocedure toScrA(var s;d,n:word;a:byte);assembler;asmπ mov cx,n; jcxz @X;π push ds; mov es,vSeg;π mov di,d; shl di,1;π lds si,s; cld;π mov al,a;  {attribute}π@L: movsb; {doesn't affect al reg}π stosb; loop @L;π pop ds;π@X:π end;ππprocedure fillScr(d,n:word;c:char);assembler;asmπ mov cx,n; jcxz @X;π mov es,vSeg;π mov di,d; shl di,1;π mov al,c; cld;π@L: stosb; inc di; loop @L;π@X:π end;ππprocedure fillAttr(d,n:word;a:byte);assembler;asmπ mov cx,n; jcxz @X;π mov es,vSeg;π mov di,d; shl di,1;π mov al,a; cld;π@L: inc di; stosb; loop @L;π@X:π end;ππfunction ScreenAdr (Row,Col : Byte) : WORD;πBEGINπ   ScreenAdr := PRED (Row) * ScrCols + PRED (Col) * 2;πEND;ππprocedure qwrite(Row, Col, Attr: byte; S: string);πBEGINπtoScrA(MemW[Seg(S):SUCC(Ofs(S))], ScreenAdr(Row,Col), Length(S), Attr);πEND;ππBEGINπIF VMode = 7 Then VSeg := $B000;πEND.ππππKeep in mind these are VERY low-level and aren't necessarily gonna beπeasy to work with but they are, by god, FAST.ππLD>As to why I pass attributes and don't use WhereX() and WhereY(), I wroteπLD>QWRITE mostly for screen drawing -- in fact, QWRITE doesn't even move theπLD>cursor.  It's no good for "scrolling" text, but goldang, when you wantπLD>to draw a box on the screen or fill a region with a given character ...ππThese don't either (cursor? who needs it!)ππQWrite'll work a little faster now, anyway...ππ * OLX 2.2 * Cana-DOS: "Yer sure, eh?" [O]k, eh! [N]o way! [B]eauty! ?ππ--- Maximus 2.01wbπ * Origin: >>> Sun Mountain BBS <<< (303)-665-6922 (1:104/123)π                22     07-16-9306:07ALL                      MIKE BURNS               Put Char at LAST Row/Col IMPORT              14     r   ===========================================================================π BBS: Canada Remote SystemsπDate: 06-24-93 (15:09)             Number: 27660πFrom: MIKE BURNS                   Refer#: NONEπ  To: CHRIS PORTMAN                 Recvd: NO  πSubj: Re: Putting A Character R      Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Chris Portman to All <=-ππ CP> I was wondering if anyone knows how to put a character at the lastπ CP> row and the last column at the screen - every time I attempt that, theπ CP> computer scrolls down to the next line.ππ CP> Is there an assembler routine someone could write fast?ππ CP> Thanksππ CP> PS - An example of a program that does that is Novell's SYSCON for itsπ CP> background fill.ππTry this Chris;ππProcedure DVWRITE(X,Y:word;S:String;Back,Fore,BLNK:byte);πVarπI,I2:integer;πbeginπ   If (X>80) or (Y>25) or (X<1) or (Y<1) then Exit;π   If X+Length(S)>81 then Exit;π   DEC(X);π   DEC(Y);π   I2:=0;π   For I:= 0 to Length(S)-1 doπ     beginπ       Mem[$B800: (160 * y)+(x*2)+I2]:=Ord(S[I+1]);π       Mem[$B800: (160 * y)+(x*2)+I2+1]:=BLNK+(Back SHL 4)+Fore;π       INC(I2,2);π     end;πEnd;ππThis is a direct video write, and can not scroll the screen.π  Valid range X = 1..80  Y= 1..25πIf you like take out the DEC(X&Y) and you can use 0..79 0..24ππShould do the trick for you.ππ.\\ike Burnsππππ... Security, confine Ensign Portman to the brig.π--- Blue Wave/Max v2.12 [NR]π * Origin: Basic'ly Computers: Mooo-ing Right Along. (1:153/9.0)π                                                                                                                     23     07-16-9306:08ALL                      GAYLE DAVIS              Classical FASTWRITE ASM  IMPORT              18     r   πUNIT FastWrit;ππINTERFACEππprocedure  FastWrite(Strng : String; Row, Col, Attr : Byte);ππIMPLEMENTATIONππVARπ    BaseOfScreen : WORD;ππprocedure  FastWrite(Strng : String; Row, Col, Attr : Byte); assembler;π  asmπ      PUSH    DS                     { ;Save DS }π      MOV     CH,Row                 { ;CH = Row }π      MOV     BL,Col                 { ;BL = Column }ππ      XOR     AX,AX                  { ;AX = 0 }π      MOV     CL,AL                  { ;CL = 0 }π      MOV     BH,AL                  { ;BH = 0 }π      DEC     CH                     { ;Row (in CH) to 0..24 range }π      SHR     CX,1                   { ;CX = Row * 128 }π      MOV     DI,CX                  { ;Store in DI }π      SHR     DI,1                   { ;DI = Row * 64 }π      SHR     DI,1                   { ;DI = Row * 32 }π      ADD     DI,CX                  { ;DI = (Row * 160) }π      DEC     BX                     { ;Col (in BX) to 0..79 range }π      SHL     BX,1                   { ;Account for attribute bytes }π      ADD     DI,BX                  { ;DI = (Row * 160) + (Col * 2) }π      MOV     ES,BaseOfScreen        { ;ES:DI points to BaseOfScreen:Row,Col }ππ      LDS     SI,DWORD PTR [Strng]   { ;DS:SI points to St[0] }π      CLD                            { ;Set direction to forward }π      LODSB                          { ;AX = Length(St); DS:SI -> St[1] }π      XCHG    AX,CX                  { ;CX = Length; AL = WaitForRetrace }π      JCXZ    @FWExit                { ;If string empty, exit }π      MOV     AH,Attr                { ;AH = Attribute }π    @FWDisplay:π      LODSB                          { ;Load next character into AL }π                                     { ; AH already has Attr }π      STOSW                          { ;Move video word into place }π      LOOP    @FWDisplay             { ;Get next character }π    @FWExit:π      POP     DS                     { ;Restore DS }π  end; {asm block}ππBEGINπASMπ    mov      BaseOfScreen,$B000π    mov      ax,$0F00π    int      $10π    cmp      al,2π    je       @XXXπ    cmp      al,7π    je       @XXXπ    mov      BaseOfScreen,$B800π@XXX :πend;πEND.                                                   24     08-17-9308:45ALL                      BERNIE PALLEK            MELT Chars on Video      IMPORT              23     r   (*π===========================================================================π BBS: Canada Remote SystemsπDate: 07-14-93 (10:28)             Number: 30550πFrom: BERNIE PALLEK                Refer#: NONEπ  To: DENNIS HO                     Recvd: NOπSubj: NEATO VIDEO TRICKS             Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πDH>     Could anyone possibly tell me how I could make theπDH> characters on the screen change the the next letter untilπDH> they are Z then they disappear?  Sort of a melting effect.πDH> I realize that this would probably have to be done in ASMπDH> but I would just like the source to incorperate into one ofπDH> my programs.ππHi, Dennis.  Just a suggestion: it would probably look better if theyπdecremented down to a space character (and it would be easier toπprogram), but here's an example:π*)ππPROGRAM MeltTheCharactersInVideoMemory;ππ{ untested, by Bernie Pallek, 1993 }π{ best used in 80x25 mode, or you may have problems :') }ππ{ I don't think the program needs a USES clause }ππCONSTπ     vidSeg : Word = $B800;  { use $B000 for mono monitors }ππVARπ   max : Byte;π   w1,π   w2  : Word;ππBEGINπ     { the below part finds the max. number of iterations req'd byπ       the melting loop }π     max := 0;π     FOR w1 := 0 TO 1999 DO IF (Mem[vidSeg : w1 * 2] > max) THENπ         max := Mem[vidSeg : w1 * 2];π     { I know, I know, bad indenting style :') }π     FOR w1 := 1 TO max DO { could be from *0* TO max }π         { by using w1 * 2, we skip the colour attributes }π         FOR w2 := 0 TO 1999 DO IF (Mem[vidSeg : w2 * 2] > 32) THENπ             Mem[vidSeg : w2 * 2] := Mem[vidSeg : w2 * 2] - 1;πEND.ππOh, you want me to *explain* it.  I see.  Well, text video memory is setπup like this: 4000 bytes starting at $B800 (for colour, $B000 for mono).πThe first byte ($B800 : 0) rep's the ASCII code of the char at 1, 1π(screen pos.), and the next byte ($B800 : 1) rep's the colour attributeπof the char at 1, 1.  Then comes the ASCII code for the next character,πand then the colour for it.  This keeps going, and when you reach memoryπposition $B800 : 160 (that 160 is decimal, not hex), it wraps to theπnext line on your screen.  This goes on until you reach $B800 : 3999,πwhich is the lower-right char's colour attribute.πThe beginning part just finds how many times the characters will haveπto be updated before they are all space characters.πBTW, sorry for not making them turn to Zs; it was easier to do it withπspaces, and you may modify the program as you wish.ππHave fun, TTYL.ππBernie.π___π * SLMR 2.0 * ... I wouldn't be caught dead with a necrophiliac!ππ--- Maximus 2.01wbπ * Origin: * idiot savant * [phone] * (1:247/128)π                                                                            25     08-23-9309:15ALL                      WILLIAM SCHROEDER        Get Video Char Direct    IMPORT              13     r   ===========================================================================π BBS: Canada Remote SystemsπDate: 08-18-93 (08:32)             Number: 34760πFrom: WILLIAM SCHROEDER            Refer#: NONEπ  To: CHRIS PORTMAN                 Recvd: NO  πSubj: RE: DIRECT VIDEO WRITES        Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Chris Portman to All <=-ππ CP> Can anyone write me a procedure that will write a character on theπ CP> screen without moving the cursor (ie - DirWrite (80, 25, '!');). Iπ CP> just need this to write to the space at 80x25 without scrolling theπ CP> screen.ππfunction GetChar(x, y: integer): char;  (* $B000 for mono *)πvar screen: array[1..25, 1..80] of word absolute $B800:0000;πbeginπ  GetChar := char(screen[x][y] and $FF);πend;ππfunction GetTextColor(x, y: integer): integer;  (* $B000 for mono *)πvar screen: array[1..25, 1..80] of word absolute $B800:0001;πbeginπ  GetTextColor := integer(screen[x][y] and $FF);πend;ππ  This is not the answer to your problem, but I'm sure it will help. All youπhave to do (I *think*) is write back to the screen variable (BIOS). Keep inπmind that X and Y are in DOS format. For some reason, DOS's X-Axis isπvertical and Y-Axis is horizontal; CRT.GotoXY reverses that.π  Sorry I couldn't help further...ππ... Only reasonable people agree with me.π--- GEcho 1.00π * Origin: Not Ready For Prime Time * Victoria, Texas (1:3802/221.0)π                                                                      26     08-23-9309:16ALL                      JOHN GIESBRECT           Direct Video in BASM     IMPORT              15     r   {π===========================================================================π BBS: Canada Remote SystemsπDate: 08-17-93 (19:47)             Number: 34561πFrom: JOHN GIESBRECHT              Refer#: NONEπ  To: CHRIS PORTMAN                 Recvd: NOπSubj: DIRECT VIDEO WRITES            Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πChris Portman (1:229/15) wrote to All on <15 Aug 10:38> :ππ CP> Can anyone write me a procedure that will write a character onπ CP> the screen without moving the cursor (ie - DirWrite (80, 25,π CP> '!');). I just need this to write to the space at 80x25π CP> without scrolling the screen.π}πUSESπ  crt;ππPROCEDURE writechar (c : CHAR; attr, x, y : BYTE); assembler;ππ(*  assumes video page 0π *  upper left-hand corner is (1, 1)π *)πasmπ  mov ax, $0300   (* get cursor position *)π  XOR bh, bhπ  INT $10π  push dx         (* and save it *)π  mov ax, $0200   (* set cursor position *)π  XOR bh, bhπ  mov dh, BYTE PTR yπ  DEC dhπ  mov dl, BYTE PTR xπ  DEC dlπ  INT $10π  mov ah, $09     (* write char and attribute *)π  mov al, BYTE PTR cπ  XOR bh, bhπ  mov bl, BYTE PTR attrπ  mov cx, $0001π  INT $10         (* restore original cursor position *)π  mov ax, $0200π  XOR bh, bhπ  pop dxπ  INT $10πEND;ππPROCEDURE WriteString (Row, Col, Attr : BYTE; STR : STRING);πVAR Len : Byte ABSOLUTE Str;π    I   : Byte;πBEGINπ  FOR I := 1 To Len DO  writechar (STR[i], Attr, Col + i, Row);πEND;ππBEGINπ  CLRSCR;π  GOTOXY (40, 13);π  writechar ('*', $0F, 1, 1);π  writechar ('*', $0e, 80, 1);π  writechar ('*', $0d, 1, 25);π  writechar ('*', $0c, 80, 25);π  WriteString(15,25,31,'Gayle Davis was here');π  READKEY;πEND.ππ- - - MSQ - EE 2.1a / e2π * Origin : * idiot savant * St. Catharines, ON, Canada * (1 : 247 / 128)π  27     08-27-9320:27ALL                      DAVID DRZYZGA            Changing Screen Attr     IMPORT              6      r   {πDAVID DRZYZGAππ> I want to know how to get and set the screen colors Without using theπ> Crt Unit or ansi codes.  Any help is appreciated.ππThis will do what you ask. There is no checking of the vidseg since it isπassumed that if you want to Write in color that you are using a color monitor:π}ππProcedure WriteColorAt(X, Y : Byte; St : String; Attr : Byte);πVarπ  Count : Byte;πbeginπ  For Count := 1 to Length(St) doπ  beginπ    Mem[$B800 : 2 * (80 * (Y - 1) + X + Count - 2)] := Ord(St[Count]);π    Mem[$B800 : 2 * (80 * (Y - 1) + X + Count - 2) + 1] := Attr;π  end;πend;ππbeginπ  WriteColorAt(34, 12, 'Hello World!', $4E);πend.π      28     08-27-9321:19ALL                      SEAN PALMER              Very FAST FASTwrite      IMPORT              11     r   {πSEAN PALMERππ> I don't know if you'd be interested, but here's my version of aπ> direct-video writer: QWRITE.ππI've optimized it a little, if you're interested... 8)ππThis is WITHOUT using inline ASM... I have routines that would put thisπoptimized version to shame, in assembler....ππThis runs 2290 times in the time it took yours to run 1754 times in aπtest I ran.ππI suggest removing the f and b parameters, and using the crt.textAttrπvariable so the user can set textcolor() and textbackground() beforeπcalling the routine and it'll come out ok, since you depend on crtπanyway for the lastmode var... actually why not use wherex() andπwherey() instead of passing THOSE as parameters too... hmm...π}ππprocedure qwrite(x, y : byte; s : string; f, b : byte);ππ{ Does a direct video write -- extremely fast.  <----heheheπ  X, Y = screen location of first byte;π  S = string to display;π  F = foreground color;π  B = background color. }ππvarπ  cnter  : word;π  vidPtr : ^word;π  attrib : word;ππbeginπ  attrib := swap((b shl 4) + f);π  vidptr := ptr($B800, 2 * (80 * pred(y) + pred(x)));π  if lastmode = 7 thenπ    dec(longint(vidptr), $08000000);π  for cnter := 1 to length(s) doπ  beginπ    vidptr^ := attrib or byte (s[cnter]);π    inc(vidptr);π  end;πend;π                   29     08-27-9321:53ALL                      SEAN PALMER              Get/Set Screen Colors    IMPORT              5      r   {πSEAN PALMERππ> I want to know how to get and set the screen colors Without using theπ> Crt Unit or ansi codes.  Any help is appreciated.ππChange the Byte in video memory For the attribute For a Character.π}ππVarπ  ScreenMem : Array [0..24, 0..79, 0..1] of Char Absolute $B800 : 0;ππProcedure changeColor(x, y, attrib : Byte);πbeginπ  screenMem[y - 1, x - 1, 1] := Char(attrib);πend;ππ{ For monochrome monitors it's Absolute $B000 : 0; }πbeginπ  ChangeColor(34, 12, $1C);πend.                                   30     08-27-9321:54ALL                      LOU DUCHEZ               Window Shadows           IMPORT              16     r   {πLOU DUCHEZππ> When I open the window, I want to give it a shadow, in C what youπ>would do is switch the 2nd bit of each character.ππShadowing here.  You'll need "Crt" for this to work:π}ππprocedure atshadow(x1, y1, x2, y2 : byte);π{ Makes a "shadow" to the right of and below a screen region, by setting theπ  foreground there to low intensity and the background to black. }πtypeπ  videolocation = recordπ    videodata      : char;π    videoattribute : byte;π  end;πvarπ  xbegin, xend,π  ybegin, yend,π  xcnt, ycnt   : byte;π  videosegment : word;π  monosystem   : boolean;π  vidptr       : ^videolocation;ππbeginπ  { Determine location of video memory. }π  monosystem := (lastmode in [0, 2, 7]);π  if monosystem thenπ    videosegment := $b000π  elseπ    videosegment := $b800;π  { Determine the x coordinates where the shadowing begins and ends on theπ    lower edge.  (Basically two spaces to the right of the box.) }ππ  xbegin := x1 + 2;π  xend   := x2 + 2;ππ  { Determine the y coordinates where the shadowing begins and ends on theπ    right.  (Basically one row below the box.) }ππ  ybegin := y1 + 1;π  yend   := y2 + 1;π  ycnt   := ybegin;π  while (ycnt <= yend) and (ycnt <= 25) doπ  beginπ  { This loop goes through each row, putting in the shadows on the right andπ    bottom.  First thing to check on each pass: if we're not below the regionπ    to shadow, shade only to the right.  Otherwise, start at the left. }π    if ycnt > y2 thenπ      xcnt := xbeginπ    elseπ      xcnt := x2 + 1;π    vidptr := ptr(videosegment, 2 * (80 * (ycnt - 1) + (xcnt - 1)));π    while (xcnt <= xend) and (xcnt <= 80) doπ    beginπ    { This loop does the appropriate shadowing for this row. }π      vidptr^.videoattribute := vidptr^.videoattribute and $07; { SHADOW! }π      xcnt := xcnt + 1;π      inc(vidptr);π    end;π    ycnt := ycnt + 1;π  end;πend;ππ                                                                    31     08-27-9321:55ALL                      POON ROJANASOONTHON      Turn Screen On/Off       IMPORT              11     r   {πPoon Rojanasoonthonππ>I use alot of line draws and some text on the screen....the lines come outπ>first and then the text a second or two later....is there a way so that theπ>whole output comes at once.  I tried Setvisualpage and setactivepage but theπ>the whole output screen is off.ππTo Turn On/Off the Screen you may use these proceduresπ}ππProcedure ScreenOn;πBeginπ  Port[$3C4] := 1;π  Port[$3C5] := $00;πend;ππProcedure ScreenOff;πBeginπ  Port[$3C4] := 1;π  Port[$3C5] := Port[$3C5] or $20;πend;ππ{π>And my last question is.....I am also writing a card game in graphics.  I knπ>the ASCII values for the heart, club, spades and diamonds are thru 3-6.  Theπ>come out in the TEXT mode but they won't show on the screen in GRAPHICS.  Isπ>there a way to display them or not?  Thanks.πTo Put text in graphics screen you should turn off the directvideo to off first.π        DirectVideo:=False;π}ππbeginπ  Writeln('Turning Screen Off...');π  Readln;π  ScreenOff;π  Writeln('Can you see this??');π  Writeln('Can you see this??');π  Writeln('Can you see this??');π  Writeln('Can you see this??');π  Writeln('Can you see this??');π  Writeln('Can you see this??');π  Writeln('Can you see this??');π  Readln;π  ScreenOn;π  Readln;πend.π                                                32     08-27-9321:55ALL                      LOU DUCHEZ               Direct Write & Scroll    IMPORT              30     r   {πLOU DUCHEZππ>I have two questions. First, How can I display ANSI files from a Pascalπ>program by using the CON driver (read: ANSI.SYS) instead of going to theπ>trouble of writing a terminal emulator, and still remainπ>window-relative? I used TP5.5's WRITE procedure to write to a fileπ>assigned to the CON device instead of the CRT unit's standard OutPut,π>but this obliterated my status line at the bottom of the screen when theπ>ANSI file scrolled. Is there an easy way to write to the CON deviceπ>while remaining window-relative without having to modify ANSI.SYS orπ>write a terminal emulation procedure?π> My second question: How can I call a batch file from within a Pascalπ>program and pass %1-%9 parameters to it? I'm aware of the EXECπ>procedure, but doesn't that only work on executables?ππSecond question first: you're right about EXEC calling only executables.πSo try calling "COMMAND.COM" as your program, and give it parameters ofπ"/C " plus the batch file name plus whatever arguments you intend to pass.π(That tells the system to run a single command out of DOS.)  Look upπParamCount and ParamStr() to see how Pascal uses command-line parameters.ππFirst question second: you know, I addressed this problem just yesterdayπtrying to write a program.  I concluded that, if you're going to bypassπCRT, you need to do a lot of "manual" work yourself to keep a windowπgoing.  Let me show you the tools I devised:πππ---PROCEDURE ATSCROLL: SCROLLS A SCREEN REGION UP OR DOWN (negative orπ   positive number in LINESDOWN, respectively)π}ππprocedure atscroll(x1, y1, x2, y2 : byte; linesdown : integer);πvarπ  tmpbyte,π  intbyte,π  clearattrib : byte;πbeginπ  if linesdown <> 0 thenπ  beginπ    clearattrib := foxfore + foxback shl 4;π    x1 := x1 - 1;π    y1 := y1 - 1;π    x2 := x2 - 1;π    y2 := y2 - 1;π    if linesdown > 0 thenπ      intbyte := $07π    elseπ      intbyte := $06;π    tmpbyte := abs(linesdown);π    asmπ      mov ah, intbyteπ      mov al, tmpbyteπ      mov bh, clearattribπ      mov ch, y1π      mov cl, x1π      mov dh, y2π      mov dl, x2π      int 10hπ    end;π  end;πend;ππ{π---FUNCTION YPOS: Returns the line the cursor is on.  I wrote it becauseπ   I don't always trust WHEREY (or WHEREX): they report, for example, theπ   cursor position relative to a text window.  So I had it lying around,π   and I opted to use it in my routines.π}πfunction ypos : byte;πvarπ  tmpbyt : byte;πbeginπ  asmπ    mov ah, 03hπ    mov bh, 0π    int 10hπ    mov tmpbyt, dhπ  end;π  ypos := tmpbyt + 1;πend;ππ{π--- PROCEDURE WRITEANDFIXOVERHANG: I use it in place of WRITELN in myπ    program: before writing a line of text, it checks if there's roomπ    at the bottom of the screen.  If not, it scrolls the screen upπ    before writing.  Keep in mind that this program is bent on preservingπ    the top three or four screen lines, not the bottom lines.π}πprocedure writeandfixoverhang(strin : string);πconstπ  scrollat : byte = 24;πvarπ  overhang : byte;πbeginπ  if ypos >= scrollat thenπ  beginπ    overhang := ypos - scrollat + 1;π    atscroll(0, 4 + overhang, 0, 80, 25, -overhang);π    movecursor(1, ypos - overhang);π  end;π  writeln(strin);πend;ππ{πSo assuming your text lines don't get too long (line longer than 160 chars),πthese routines will keep the top of your screen from getting eaten.  If youπwant to preserve space at the bottom of the screen instead (or both top andπbottom), change WRITEANDFIXOVERHANG.ππBTW, if there are any compiling problems, let me know.  I took out all theπstuff that applied specifically to my application -- I might have stupidlyπchanged something you need ...π}                                                                                               33     11-02-9305:26ALL                      BRIAN PAPE               Very FAST Clear Screen   SWAG9311            4      r   {πBRIAN PAPEππ>Mike, thought i would share a different way to clear the screenπ>it clears the screen directly and tends to be fasterπ}ππProcedure ClrScr(attr : Byte; ch : Char); Assembler;πAsmπ  mov  ax, $b800π  mov  es, axπ  xor  di, diπ  mov  cx, 80*25π  mov  ah, attrπ  mov  al, &chπ  rep  stoswπend;π                                                                                34     11-21-9309:45ALL                      CYRUS PATEL              SMOOTH Scroll            SWAG9311            35     r   {πFrom: CYRUS PATELπSubj: Stuff...π>Does anyone have either ASM or TP (7.0) code to do vga scrolling, ie asπin BBS demos, loaders...ππ------------------------ SWAG snippet ---------------------------π{π Here is some demo code showing how to use Smooth.Obj.  It offersπ vertical and horizontal smooth scrolling in Text or Graphics modes.ππ NOTE:      Requires Smooth.Obj (see below)   EGA & VGA ONLY !!!!ππ REQUIRES:  Smooth.Obj  Run the debug script through DEBUG to createπ            Smooth.Obj.  The NEXT message has the debug script.ππ ALSO:      Until last week, I'd never seen a line of Pascal code.π            So ForGIVE the rough edges of this code:  bear in mindπ            the Complete novice status of its author <!!G!!>           }ππUses Crt;ππ{ NOTE:  SmoothScroll is a MEDIUM MODEL Asm/OBJ For use inπ         **either** Pascal or most flavors of modern BASIC.ππ         It expects parameters to be passed by reference!  We handleπ         that here by not including Var, then passing Ofs(parameter).ππ         Don't know if this is appropriate, but it works. Comments?   }ππ{$F+} Procedure SmoothScroll(Row, Column: Integer); external; {$F-}π{$L Smooth.Obj}ππVarπ   Row, Col, Speed, WhichWay : Integer;π   Ch : Char;π   s  : String [60];ππbeginπ   TextColor (14); TextBackground (0); ClrScr;ππ   GotoXY (25,4);  Write ('Press <Escape> to move on.');ππ   ch := 'A';π   For Row := 10 to 24 doπ       beginπ         FillChar (s, Sizeof(s), ch);π         s[0] := #60;  Inc (ch);π         GotoXY (10, Row); Write (s);π       end;ππ   Speed := 1;                         { Change Speed!  See notes. }ππ   {The higher the Speed, the faster the scroll.π        Use Speed = 1 For subtle scrolling.π        Try Speed = 5 (10 in Graphics) For very fast scrolling.π        Try Speed = 10+ (25 in gfx) to see some **Real shaking**.ππ        Even in Text mode here, Row and Column use GraphICS MODEπ        pixel coordinates (ie., begin w/ 0,0).   }ππ   {================================= demo vertical smooth scrolling}π   Row := 0; Col := 0;π   WhichWay := Speed;                   { start by going up }ππ   Repeat                               { press any key to end demo }π      GotoXY (2,10);  Write (Row, ' ');π      SmoothScroll(ofs(Row), ofs(Col));π      Row := Row + WhichWay;ππ      if (Row > 150) or (Row < 2) then  { try 400 here }π         WhichWay := WhichWay * -1;     { reverse direction }ππ      if Row < 1 then Row := 1;ππ   Until KeyPressed;ππ   ch := ReadKey; Row := 0; Col := 0;π   SmoothScroll ( ofs(Row), ofs(Col) ); { return to normal (sort of) }ππ   {================================= demo horizontal smooth scrolling}π   Row := 0; Col := 0;π   WhichWay := Speed;                   { start by going left }ππ   Repeat                               { press any key to end demo }π      GotoXY (38,3); Write (Col, ' ');π      SmoothScroll(ofs(Row), ofs(Col));π      Col := Col + WhichWay;ππ      if (Col > 65) or (Col < 0) then   { try 300 here }π         WhichWay := WhichWay * -1;     { reverse direction }π      if Col < 0 then Col := 0;π   Until KeyPressed;ππ   Row := 0; Col := 0; SmoothScroll(ofs(Row), ofs(Col));πend.ππ{ Capture the following to a File (eg. S.Scr).π then:    DEBUG < S.SCR.ππ Debug will create SMOOTH.OBJ.ππ N SMOOTH.OBJπ E 0100 80 0E 00 0C 73 6D 74 68 73 63 72 6C 2E 61 73 6Dπ E 0110 87 96 27 00 00 06 44 47 52 4F 55 50 0D 53 4D 54π E 0120 48 53 43 52 4C 5F 54 45 58 54 04 44 41 54 41 04π E 0130 43 4F 44 45 05 5F 44 41 54 41 90 98 07 00 48 89π E 0140 00 03 05 01 87 98 07 00 48 00 00 06 04 01 0E 9Aπ E 0150 04 00 02 FF 02 5F 90 13 00 00 01 0C 53 4D 4F 4Fπ E 0160 54 48 53 43 52 4F 4C 4C 00 00 00 A7 88 04 00 00π E 0170 A2 01 D1 A0 8D 00 01 00 00 55 8B EC 06 56 33 C0π E 0180 8E C0 8B 76 08 8B 04 33 D2 26 8B 1E 85 04 F7 F3π E 0190 8B D8 8B CA 26 A1 4A 04 D0 E4 F7 E3 8B 76 06 8Bπ E 01A0 1C D1 EB D1 EB D1 EB 03 D8 26 8B 16 63 04 83 C2π E 01B0 06 EC EB 00 A8 08 74 F9 EC EB 00 A8 08 75 F9 26π E 01C0 8B 16 63 04 B0 0D EE 42 8A C3 EE 4A B0 0C EE 42π E 01D0 8A C7 EE 4A 83 C2 06 EC EB 00 A8 08 74 F9 83 EAπ E 01E0 06 B0 08 EE 8A C1 42 EE 83 C2 05 EC BA C0 03 B0π E 01F0 33 EE 8B 76 06 8B 04 24 07 EE 5E 07 8B E5 5D CAπ E 0200 04 00 F5 8A 02 00 00 74π RCXπ 0108π Wπ Qππ'========  end of Debug Script ========π                                                                                                 35     11-02-9308:25ALL                      GREG ESTABROOKS          Move to Screen Pages     SWAG9311            10     r   { Updated SCREEN.SWG on November 2, 1993 }ππ{πGREG ESTABROOKSππ>I know how to block-Write directly into $B800:0000, which is the Videoπ>page, using the MOVE command. Is there a way to do this to a specificπ>Page (ie. Page 1, or Page 2)? I've tried it With my routines, but itπ>just sends it to whatever page I'm looking at - I assume becuase it is aπ>direct access.ππ  Actually if you understand how to use MOVE to blockmoveπ  everything into $B800:0000 then you already know how to moveπ  it into the other pages. All you need to do is calculate theπ  offsets of the different pages.π  Page 0 = $B800:$0000π  Page 1 = $B800:$0FA0π  Page 2 = $B800:$1F40π  Page 3 = $B800:$2EE0π  (Note These might differ if your using 43/50 line modes)ππ  So if you wanted to move/copy a screen from a buffer to page 1π  you'd do it like this:π}ππConstπ  PageOffs : Array [0..3] of Word = ($0000, $0FA0, $1F40, $2EE0);ππ  Move(Buffer[1], Mem[$B800 : PagesOffs[1]], 4000);ππ{ Or from screen 1 to 0 then : }ππ  Move(Mem[$B800 : PageOffs[1]], Mem[$B800 : PageOffs[0]], 4000);ππ                                                                                               36     10-28-9311:37ALL                      GREG ESTABROOKS          Screen I/O Routines      SWAG9311            27     r   {***********************************************************************}πPROGRAM ScreenPortDemo;         { Sept 6/93, Greg Estabrooks.           }πUSES CRT;                       { LastMode,Clrscr.                      }πCONSTπ     Speed = 50;                { Define speed for moving screen portion}π     {******** Change this to make the screen move faster/slower *******}πTYPEπ        ScreenPort = RECORDπ                        ScreenSt :ARRAY[1..4000] OF BYTE;π                        NumCols,π                        NumRows  :BYTE;π                     END;ππ        ScreenPtr = ^ScreenSet;π        ScreenSet = ARRAY[1..50,1..80,0..1] OF BYTE;π                        {  1..50 = Row,  0..79 = Col, 0 = Character,π                                                      1 = Color Byte    }πVARπ        TextScreen     :SCREENPTR;π        BaseOfScreen   :WORD;π        BPort,π        SPort          :ScreenPort;π        Row,Colm       :WORD;ππPROCEDURE SaveScrPort( Col1, Row1, Col2, Row2 :BYTE; VAR ScrP :SCREENPORT );πVARπ        LLength :BYTE;π        Counter1,Counter2  :WORD;πBEGINπ  Counter2 := 1;π  LLength := (2 * (Col2 - Col1))+2;π  For Counter1 := Row1 To Row2 DOπ    BEGINπ      Move(TextScreen^[Counter1,Col1,0],ScrP.ScreenST[Counter2],LLength);π      Inc(Counter2,LLength);π    END;π  ScrP.NumCols := LLength;π  ScrP.NumRows := Row2 - Row1;πEND;ππPROCEDURE RestoreScrPort( Col,Row :BYTE; VAR ScrP :SCREENPORT );πVARπ   Counter1,Counter2  :WORD;πBEGINπ  Counter2 := 1;π  For Counter1 := Row To (Row + ScrP.NumRows) Doπ    BEGINπ      Move(ScrP.ScreenST[Counter2],TextScreen^[Counter1,Col,0],ScrP.NumCols);π      Inc(Counter2,ScrP.NumCols);π    END;πEND;ππBEGINπ  IF LastMode = 7 THEN          { Check current video mode.             }π    BaseOfScreen := $B000       { If Monochrome load mono segment.      }π  ELSEπ    BaseOfScreen := $B800;      { if not load color segment.            }π  TextScreen := Ptr(BaseOfScreen,0); { Now point TextScreen proper area.}ππ  SaveScrPort(10,5,20,15,BPort);{ Save a cleared part of the screen.    }π  GotoXY(1,1);                  { Move to top corner of screen.         }ππ  FOR Row := 1 to 20 DO         { Generate screen for demonstration.    }π    FOR Colm := 1 to 80 DOπ       Write('A');ππ  SaveScrPort(10,5,20,15,SPort);{ Save a portion of the screen.         }π  ClrScr;                       { Clear the screen.                     }π  SaveScrPort(10,5,20,15,BPort);{ Redisplay saved portion.              }ππ  FOR Colm := 10 to 50 DO       { Animate portion right.                }π   BEGINπ     RestoreScrPort(Colm,5,SPort);π     Delay(Speed);π     RestoreScrPort(Colm,5,BPort);π   END;ππ  FOR Row := 5 to 14 DO         { Animate Portion Down.                 }π   BEGINπ     RestoreScrPort(50,Row,SPort);π     Delay(Speed);π     RestoreScrPort(50,Row,BPort);π   END;ππ  FOR Colm := 50 DOWNTO 10 DO   { Animate Portion Left.                 }π   BEGINπ     RestoreScrPort(Colm,14,SPort);π     Delay(Speed);π     RestoreScrPort(Colm,14,BPort);π   END;ππ  FOR Row := 14 DOWNTO 5 DO     { Animate Portion Up.                   }π   BEGINπ     RestoreScrPort(10,Row,SPort);π     Delay(Speed);π     RestoreScrPort(10,Row,BPort);π   END;π   RestoreScrPort(10,5,SPort);π  Readln;πEND.π{***********************************************************************}           37     11-02-9306:17ALL                      KELLY SMALL              Grabbing Screen Output   SWAG9311            12     r   {πKELLY SMALLππOk here's a quick example of how you can control the screenπoutput during an Exec.  BAsically you hook Int $29 which is anπinternal bios hook For screen output.  Any Character that wouldπgo to the screen is intercepted by the Interrupt handler and thenπTP's Write Procedure is used to output the Charcater to theπscreen.  Please note that this will only work With the Crt Unitπand it's direct screen Write methods, not output via the Dosπdevice..  Of course I assume you are using the Crt Unit since youπare also using the Window Procedure.  if the Program you execπUses direct screen Writes then this routine will not work.π}ππProgram WinHold;π{$M 8096,0,0}πUsesπ  Crt, Dos;ππVarπ  OldIntVect : Pointer;ππ{F+}πProcedure Int29Handler(AX, BX, CX, DX, SI, DI, DS, ES, BP : Word); Interrupt;πVarπ  Dummy : Byte;πbeginπ  Asmπ    Stiπ  end;π  Write(Char(Lo(Ax)));π  Asmπ    Cliπ  end;πend;π{$F-}ππbeginπ  ClrScr;π  Writeln('this line better stay put');π  Window(10, 15, 60, 25);π  GetIntVec($29, OldIntVect);            { Save the old vector }π  SetIntVec($29, @Int29Handler);         { Install interrupt handler }π  SwapVectors;π  Exec(GetEnv('COMSPEC'),'/c dir /p');π  SwapVectors;π  SetIntVec($29, OldIntVect);            { Restore the interrupt }π  Window(1, 1, 80, 25);π  GotoXY(1, 2);π  Writeln('2nd line I hope');π  ReadLn;πend.ππ                                                             38     11-02-9305:02ALL                      KIMBA DOUGHTY            Box Shadows              SWAG9311            18     r   {πKIMBA DOUGHTYππ> could someone tell me how to do a shadow Window.. you know the Type thatπ> has a Window then a shadow of what is under the Window in color 8 or darkπ> gray... Either in Inline assembly or Straight Pascal...π}ππUnit shadow;ππInterfaceππUsesπ  Crt, Dos;ππProcedure WriteXY(X, Y : Integer; S : String);πFunction  GetCharXY(X, Y : Integer) : Char;πProcedure SHADE(PX, PY, QX, QY : Integer);πProcedure BOX(PX, PY, QX, QY : Integer);πProcedure SHADOWBOX(PX, PY, QX, QY : Integer; fg, bg : Byte);ππImplementationππProcedure menubox(x1, y1, x2, y2 : Integer; fg, bg : Byte);πVarπ  count : Integer;πbeginπ  TextColor(fg);π  TextBackGround(bg);π  Writexy(x1 + 1, y1, '╔');ππ  For count := x1 + 2 to x2 - 2 doπ    Writexy(count, y1, '═');ππ  Writexy(x2 - 1, y1, '╗');π  For count := y1 + 1 to y2 - 1 doπ    Writexy(x1 + 1, count, '║');ππ  Writexy(x1 + 1, y2, '╚');π  For count := y1 + 1 to y2 - 1 doπ    Writexy(x2 - 1, count, '║');ππ  Writexy(x2 - 1, y2, '╝');π  For count := x1 + 2 to x2 - 2 doπ    Writexy(count, y2, '═');πend;ππProcedure WriteXY(X, Y : Integer; S : String);πVarπ  SX, SY : Integer ;πbeginπ  SX := WhereX;π  SY := WhereY;π  GotoXY(X, Y);π  Write(S);π  GotoXY(SX, SY);πend;ππFunction GetCharXY(X, Y : Integer) : Char;πVarπ  Regs : Registers;π  SX, SY : Integer;πbeginπ  SX := WhereX;π  SY := WhereY;π  GotoXY(X, Y);π  Regs.AH := $08;π  Regs.BH := $00;π  Intr($10, Regs);π  GetCharXY := Char(Regs.AL);π  GotoXY(SX, SY);πend;ππProcedure SHADE(PX, PY, QX, QY : Integer);πVarπ  X, Y : Integer;πbeginπ  TextColor(8);π  TextBackGround(black);π  For Y := PY to QY Doπ  For X := PX to QX Doπ    WriteXY(X, Y, GetCharXY(X, Y));πend;ππProcedure BOX(PX, PY, QX, QY : Integer);πbeginπ  Window(PX, PY, QX, QY);π  ClrScr;πend;ππProcedure SHADOWBOX(PX, PY, QX, QY: Integer; fg, bg : Byte);πbeginπ  TextColor(fg);π  TextBackGround(bg);π  BOX(PX, PY, QX, QY);π  Window(1, 1, 80, 25);π  SHADE(PX + 2, QY + 1, QX + 2, QY + 1);π  SHADE(QX + 2, PY + 1, QX + 2, QY + 1);π  SHADE(QX + 1, PY + 1, QX + 1, QY + 1);π  MENUBOX(PX, PY, QX, QY, fg, bg);πend;ππend.ππ                                                                                                                39     11-02-9304:59ALL                      ROBERT ROTHENBURG        Set/Get Active Video PageSWAG9311            12     r   {πRobert Rothenburgππ> How do you use video pages, how do you change the current one(I guessπ> it's an register?), and if somebody could, explain to me exactly whatπ> Video Pages are?ππInterrupt $10, function 5...which in Turbo Pascal becomes (ta da!):π}ππprogram PageExample;ππusesπ  DOS;ππvarπ  reg : Registers;ππprocedure SetActivePage(Page : byte);πbeginπ  Reg.AH := 5;π  Reg.AL := Page;π  Intr($10, Reg);πend;ππ(* or, if you've got TP 7... *)ππprocedure SetActivePage(Page : byte); assembler;πasmπ  MOV AH, 5π  MOV AL, Pageπ  INT $10πend;ππ{πAccording to my handy and well-worn "DOS Programmer's Reference", theπvalid page numbers are as follows:ππPage Numbers:        Video Mode(s):        Video Adapters:π-----------------------------------------------------------------π   0..7               00, 01                 CGA, EGA, MCGA, VGAπ   0..3               02, 03                 CGAπ   0..7               02, 03                 EGA, MCGA, VGAπ   0..7               07, 0Dh                EGA, VGAπ   0..3               0Eh                     "    "π   0..1               0Fh, 10h                "    "ππOf course my edition was written in 1989 and only goes up to DOS 4 andπdoesn't mention SVGA or XGA cards etc.ππ(I don't even bother with Boreland's BGI drivers.  It's much easier toπuse my own BIOS interface units.)π}π                                                                             40     11-02-9304:54ALL                      SAM HASINOFF             Changing Borders ASM     SWAG9311            13     r   {πSAM HASINOFFππ> Can anyone help me With a Procedure that would let me change theπ> border colors on the screen?ππYou don't *need* to know BAsm, but it sure will help cut down on code size!πHere is a plain-vanilla pascal Program which Uses the Dos Unit :( !π}ππProgram BorderTest;ππUsesπ  Dos;ππProcedure border(colour : Byte);πVarπ  regs : Registers;πbeginπ regs.ah := $10;π regs.al := $01;π regs.bh := colour;π intr($10, regs);πend;ππbeginπ  border(10);πend;ππ{ Now let's reWrite the Procedure using BAsm: }ππProcedure border(colour : Byte); Assembler;πAsmπ  mov ah, 10hπ  mov al, 01hπ  mov bh, colourπ  int 10hπend;ππ{πI almost never Program in BAsm, but have picked up just enough to do theπabove with a fair amount of certainty... The code is almost self explanatory:ππThe "mov" moves the second parameter into the first:π  mov a,b    is equivalent to    a:=b;ππ(note: the h at the end of 10h, specifies that the number is hexadecimal, orπbase 16.  In pascal we Write $10 to mean 16, in BAsm we Write 10h)ππThe "int" command calls the specified interrupt... in the above example weπare calling interrupt 10h (16).  I think the ah and al Registers tell theπcomputer which Function and sub-Function of int 10h to call, While bh and blπare usually used as input values, and cx (something to do With the stack)πis normally used as an output value (like an error result from a disk read)π-- but don't quote me on any of that last sentence!π}π                                                                                             41     11-02-9306:12ALL                      SANTERI SALMINEN         Wait for Vertical RetraceSWAG9311            5      r   {πSANTERI SALMINENππ> how can i wait For the vertical retrace, in Pascal.ππSome routines For retraces:πAs you can see, $3DA reveals all of them.π}ππ Repeat Until Port[$3DA] And 8 = 8; { Wait For Vertical retrace              }π Repeat Until Port[$3DA] And 8 = 0; { Wait For the end of Vertical retrace   }π Repeat Until Port[$3DA] And 1 = 1; { Wait For Horizontal retrace            }π Repeat Until Port[$3DA] And 1 = 0; { Wait For the end of Horizontal retrace }ππ                                               42     11-02-9305:45ALL                      SEAN PALMER              Finding Number of Rows   SWAG9311            6      r   {πSEAN PALMERππ> Does anyone have any quick Procedures For detecting the number ofπ> lines as passed through the Dos "MODE" command? Ie, 25 lines, 43 or 50π> line mode? This way, when Programming a door, I can place the statusπ> line on the correct area of screen.ππTry this, anything that correctly updates the bios when it changes modesπshould be reported correctly.π}ππVarπ  rows : Byte;ππFunction getRows : Byte; Assembler;πAsmπ  mov ax, $1130π  xor dx, dxπ  int $10π  or  dx, dxπ  jnz @S   {cga/mda don't have this fn}π  mov dx, 24π @S:π  inc dxπ  mov al, dlπend;ππbeginπ  writeln(getrows);πend.π                                       43     11-02-9316:54ALL                      STEFAN XENOS             ScreenBuffer Object      SWAG9311            18     r   {πFrom: STEFAN XENOSπSubj: ScreenBuffer ObjectππNotes:π  - 0,0 is recognised as the top-left corner of the screen.π  - They seem to work perfectly when only popping one thing up at once.π}ππUses Crt;ππTypeπ TScreenBuf = Objectπ  Constructor Init (NewX,NewY,NewHeight,NewWidth:Byte);π  Destructor Done;π  Procedure KillBuffer; Virtual;π  Procedure Clip;π  Procedure Paste;π  Privateπ   Buffer :Pointer;π   Size :Byte;π   x,π   y,π   Height,π   Width :Byte;π end;ππVarπ MaxX,π MaxY :Byte;π ScreenSeg :Word;ππProcedure GoXY (x,y:Byte);πBeginπ gotoXY (x+1,y+1);πend;ππProcedure FillWith (aChar:Char);πVarπ offset:Word;πBeginπ ClrScr;π For offset := 0 to maxx*maxyπ  do move (aChar,Ptr (ScreenSeg,offset*2)^,1);πEnd;ππ{TScreenBuf}πConstructor TScreenBuf.Init (NewX,NewY,NewHeight,NewWidth:Byte);πBeginπ x := newx;π y := newy;π height := newheight;π width := newwidth;π Buffer := nil;π KillBuffer;πEnd;ππDestructor TScreenBuf.Done;πBeginπ KillBuffer;πEnd;ππProcedure TScreenBuf.KillBuffer;πBeginπ If Buffer <> nilπ  then FreeMem (Buffer,Size);π Size := 0;π Buffer := nil;πEnd;ππProcedure TScreenBuf.Clip;πVarπ ScanY :Byte;πBeginπ KillBuffer;π Size := Height*Width*2;π GetMem (Buffer,Size);π For ScanY := 0 to Heightπ  do beginπ   Move (Ptr (ScreenSeg,(Y*MaxX+ScanY*MaxX+X)*2)^,π    Ptr (Seg (Buffer^),Ofs(Buffer^)+(ScanY*Width)*2)^,Width*2);π  end;πEnd;ππProcedure TScreenBuf.Paste;πVarπ ScanY :Byte;πBeginπ For ScanY := 0 to Heightπ  do beginπ   Move (Ptr (Seg (Buffer^),Ofs(Buffer^)+(ScanY*Width)*2)^,π    Ptr (ScreenSeg,(Y*MaxX+ScanY*MaxX+X)*2)^,Width*2);π  end;πEnd;ππVarπ Clip :TScreenBuf;ππBeginπ if Lastmode = Monoπ  then screenSeg := $B000          {Mono}π else screenSeg := $B800;          {Colour}π if Lastmodeπ  and font8x8 <> 0π  then MaxY := 50                  {25X80}π else MaxY := 25;                  {50X80}π MaxX := 80;ππ textcolor (darkgray);π textbackground (lightgray);π FillWith (#178);π textcolor (yellow);π textbackground (blue);π Clip.Init (10,10,1,21);π Clip.Clip;π goXY (10,10);π Write ('Hit ENTER to continue');π While Readkey <> #13 do;π Clip.Paste;π Clip.Done;πEnd.π                                                                                     44     11-02-9305:00ALL                      SWAG SUPPORT TEAM        Display Chars at $A000   SWAG9311            16     r   {π>Does anyone know how display characters in 320x200x256 ($A000)??π>I want to write letters on the screen, but how do I? Is there aπ>way without a special program???ππ  You need to use interrupt calls to the BIOS video routines to write aπ  character to the screen.  Include the DOS unit in your program asπ  you'll need it for the definition of "Intr" and "Registers" below:π}ππprocedure SetCursorPosition(Column, Row : byte);πvarπ  reg : registers;πbeginπ   reg.AH := $02;π   reg.BH := $00;    {* Display Page Number. 0 for Graphics Modes! *}π   reg.DL := Column; {* Row/Column are Zero-Based! *}π   reg.DH := Row;π   intr($10, reg);πend;ππprocedure WriteCharAtCursor(x : char; Color : byte);πvarπ  reg : registers;πbeginπ   reg.AH := $0A;π   reg.AL := ord(x);π   reg.BH := $00;    {* Display Page Number. * for Graphics Modes! *}π   reg.BL := Color   {* For Graphics Modes only? *}π   reg.CX := 1;      {* Word for number of characters to write *}π   intr($10, reg);πend;ππ{πUse the first routine to set the cursor position and the second routineπto write the character.  (I don't remember if writing a character willπmodify the cursor position or not--you'll have to play with that one).πPlay with these routines a bit and write another to output a string &πyou should be all set.  WARNING: the characters you write in 300x200πmode will be very large and VIC-20-like....ππI recommend you get a copy of Ron Brown's Interrupt List filesπ(INTERnnA.ZIP through INTERnnC.ZIP, where nn is the current number--myπguess if 34 or 35 by now).  I also have a copy of the "DOS Programmer'sπReference 2nd Edition" (Que Books) which describes many of theπInterrupts and how to interface with them in ASM, BASIC, C or Pascal,πas well as how DOS, BIOS, VIDEO, etc. are arranged.  It is a VERYπworthwhile reference....π}π                                                                                                               45     11-26-9317:04ALL                      SWAG SUPPORT TEAM        Dump Screen              SWAG9311            17     r   πUses CRT, DOS;ππ{-- read the character at the cursor and return it as a Char --}πFunction ScreenChar : Char;πVarπR : Registers;πbeginπ   Fillchar(R, SizeOf(R), 0);π   R.AH := 8;π   R.BH := 0;π   Intr($10, R);π   ScreenChar := Chr(R.AL);πend;ππ{-- sample routine to read the screen and dump it to an ASCII file --}π{-- it uses ScreenChar ----}πProcedure DumpScreen;πVarπNum : Integer;πX1,Y1, x,y : Byte;πS   : String[79]; {- line length string; some prefer string[80] -}πCh  : Char;πBuf : Array[1..25] of String[79]; {- buffer to hold the screen contents -}πF   : Text;πFName:String[79];ππbeginπ   x1 := WhereX; y1 := WhereY; {- save present location of the cursor -}ππ   {- initialise the variables --}π   Num := 0;π   X := 1;π   Y := 1;π   S := '';π   FillChar(Buf, Sizeof(Buf), #0);ππ {- do the stuff --}π Repeatπ   GotoXy(X,Y);         {-- start from top left of screen --}π   Inc(Num);            {-- increase line counter --}π   Ch := ScreenChar;    {-- read the character at screen location --}π   S := S+Ch;                {-- add it to temporary string --}ππ   Inc(X);                {-- goto next screen column -}π   If (Ch = #13) or (X = 79) Then {- CR, or end of screen-width-}π   beginπ     X := 1;            {- back to column 1 -}π     Buf[Y] := s;       {- put the line in buffer (string array) -}π     s      := '';      {- empty the temporary string -}π     Inc(Y);            {- goto next line (row) -}π   end;π Until (Num = 1975);    {- until we have read the screen (79*25 chars )-}ππ{-- write the buffer to a text file --}π FName := 'SCREEN.SAV';π Assign(F, FName);π SetTextBuf(F, Buf);ππ {$I-}π Append(f); {- if the file exists, append buffer to it -}π{$I+}π  If IoResult <> 0 Then ReWrite(f); {- else create a new one -}ππ  For x := 1 to 25 do Writeln(F, Buf[x]); {- write it -}ππ{$I-}π  Close(F);π{$I+}π  If IoResult <> 0 Then;ππ  GotoXy(x1,y1); {- return to original location -}πend;ππBEGINπDumpScreen;πEND.π                                                                                                                  46     11-21-9309:34ALL                      SWAG SUPPORT TEAM        More FASTWRITE Routines  SWAG9311            17     r   {$R-}πUNIT FWrite;π(**) INTERFACE (**)πUSES Crt;πVARπ  ScreenWidth,π  ScreenHeight : Byte;ππ  PROCEDURE FastWrite(S : String; co, ro, at : Byte);π  PROCEDURE FasterWrite(S:String; co, ro, at : Word);π  PROCEDURE CheckWidthHeight;π(**) IMPLEMENTATION (**)πTYPEπ  WordArray = ARRAY[0..65520 DIV 2] OF Word;πVARπ  Display  : ^WordArray;π  Crt_Cols : Word ABSOLUTE $0040:$004A;π  Crt_Rows : Word ABSOLUTE $0040:$0084;ππ  PROCEDURE FastWrite(S : String; co, ro, at : Byte);π  VARπ    Start, WordAttr : Word;π    N : Byte;π  BEGINπ    Start:= pred(ro)*ScreenWidth + pred(co);π    WordAttr := Word(At) SHL 8;π    FOR N := 1 to length(S) DOπ      Display^[start+pred(N)] := WordAttr + ord(S[N]);π  END;ππ  PROCEDURE FasterWrite(S:String; co,π                        ro, at : Word); Assembler;π  ASMπ    MOV AX, ro               {                        }π    DEC AL                   { These calculations     }π    SHL AL, 1                { get the initial offset }π    MUL ScreenWidth          { into the AX register   }π    ADD AX, co               {                        }π    DEC AX                   {                        }π    MOV DI, Word(Display)    { DI now points to the   }π    ADD DI, AX               { starting offset.       }π    MOV AX, Word(Display+2)π    MOV ES, AX               { ES has video segment   }π    PUSH DSπ    LDS SI, S                { DS:SI points to string }π    XOR CX, CXπ    MOV CL, [SI]             { String length in CX    }π    INC SIπ    MOV BH, Byte(At)         { Attribute in BH        }π    @Loop:π      MOVSB                  { Move a char to screen  }π      MOV ES:[DI], BH        { .. and its attribute   }π      INC DIπ    Loop @Loopπ    POP DSπ  END;ππ  PROCEDURE CheckWidthHeight;π  BEGINπ    ScreenWidth := Crt_Cols;π    ScreenHeight := succ(Crt_Rows);π  END;ππ(** INITIALIZATION **)πBEGINπ  CheckWidthHeight;π  IF LastMode = 7 THENπ    Display := Ptr($B000, 0)π  ELSE Display := Ptr($B800, 0);πEND.                                                                                                    47     11-26-9317:40ALL                      SWAG SUPPORT TEAM        Turn SCREEN On/Off       SWAG9311            6      r   {πI use alot of line draws and some text on the screen....the lines come outπfirst and then the text a second or two later....is there a way so that theπwhole output comes at once.  I tried Setvisualpage and setactivepage but theπthe whole output screen is off.ππ        To Turn On/Off the Screen you may use these procedureπ}πProcedure OnScreen;πBeginπ     Port[$3c4]:=1;π     Port[$3c5]:=Screen_AttriBute_Tempolary;πend;ππProcedure OffScreen;πBeginπ     Port[$3c4]:=1;π     Screen_Attribute_Tempolary:=Port[$3c5];π     Port[$3c5]:=Screen_AttriBute_Tempolary or $20;πend;π                                                                   48     11-21-9309:34ALL                      VARIOUS                  GETCHAR routines         SWAG9311            11     r   {πFrom: GREG ESTABROOKSππI was wondering if anybody knew how to capture a character in TurboπPascal 6.0 at any x,y location like QuickBasic's SCREEN(x,y).π}ππFUNCTION GetChar( X,Y :WORD; VAR Attrib:BYTE ) :CHAR;πVARπ   Ofs :WORD;πBEGINπ                        { NOTE: Change the Segment from $B800 }π                        {       to $B000 for MonoChrome.      }π  Ofs := ((Y-1) * 160) + ((X SHL 1) - 1);π  Attrib := MEM[$B800:Ofs];π  GetChar := CHR( MEM[$B800:Ofs-1] );πEND;ππ{πFrom: LOU DUCHEZπ------------------------------------------------------------------------------}ππfunction getvideodata(x, y: byte): char;ππ{ "Reads" a character off the video screen. }ππtype  videolocation = record                  { video memory locations }π        videodata: char;                      { character displayed }π        videoattribute: byte;                 { attributes }π        end;ππvar vidptr: ^videolocation;π    monosystem: boolean;π    videosegment: word;π    scrncols:  byte absolute $0040:$004a;π    videomode: byte absolute $0040:$0049;ππbeginπ  monosystem := (videomode = 7);π  if monosystem then videosegment := $b000 else videosegment := $b800;π  vidptr := ptr(videosegment, 2*(scrncols*(y - 1) + (x - 1)));π  getvideodata := vidptr^.videodata;π  end;π